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VISUAL ANNOTAT ION AND KNOWK 
BACKGROUND 

5 i. ghe Field of the Invention, 

The present invention relates generally to a method and system for annotating an image , and 
more particularly, but not necessarily entirely, to a computerized method and system for creating, 
storing, displaying and associating structured, vector based, interactive visual annotations and 
interactive visual notes (also referred as "IVN") with a digital image. 
10 2. Description of Background Art. 

Annotation of visual material is a necessary activity, one that represents an important part ■ 
of teaching, publishing and communicating visual information. Since the widespread adoption of 
computers and especially the Internet, the use of digital images in computer-assisted presentations 
has grown tremendously. Doctors, educators, geologists, architects, engineers, scientists are 
15 examples of professions where the use of digital images is becoming more widespread. 

Image annotating, in a broad sense, includes any technique which allows an author to label, 
point to or otherwise indicate some feature of the image that is the focus of attention, including 
textual commentary. Providing an individual with the ability to add symbols, labels and captions 
to describe the contents of an image or to convey a concept and direct the viewer to important 
20 features of an image has been established for decades. It has been long accepted that assigning 
captions or a definition and providing an option to write a legend that further describes a region 
of interest that is unique to an image allows an author to convey intellectual information 
regarding the structures in the image itself. Traditional methods for annotating images have 
allowed authors to place pointers, textual information and labels to indicate structures contained 
25 in an image but that information remains static. Moreover, to change annotated features on an 
image often requires that the author scrape off the rub-on labels and start over or to reprint the 
image and start over with annotating the features of the image. 

Today, digital image data is generated from a vast array of electronic devices and with the 
wide acceptance of the use of computers to accomplish the tasks of annotation gives rise to that 
30 fact that many applications have been designed to give authors the ability to annotate electronic 
image data. The same traditional sets of tools that have allowed authors to prepare image data for 
publication have essentially been reproduced in an electronic environment and can be used in 
addition to, or completely replace, traditional tools for annotating images. 

Digital images are typically stored as raster images, also referred to as bitmap images. 
35 Examples of formats that are raster based include JPEG, GIF, BMP, PNM, TIFF, PPM, PNG and many 
others. Raster images are generally defined to be a rectangular array of regularly sampled values, 
known as pixels. Each pixel (picture element) has one or more numbers associated with it, 
generally specifying a color which the pixel should be displayed in. Most formats for raster 
images, including those mentioned above, compress the pixel information to shrink the size of the 
10 data needed to encode the image. 

Authors of digital material are finding that creating, presenting, and cataloging digital 
images is a difficult task despite the technologic improvements. Visually annotating or 
illustrating digital images with symbols and text is a fundamental task many users of images must 
perform when preparing material for illustration. For example, clinicians % and biomedical 
15 investigators must make visual annotations when preparing material for illustration. 

Annotating visual media has evolved from scratch-on LETRASET® dry transfer labeling to using 
expensive, sophisticated and complicated image manipulation computer software like ADOBE® 
PHOTOSHOP® or MACROMEDIA® FREEHAND® software. At the same time, the need to illustrate images with 
annotations requires very little (symbols, labels, shapes and arrows) and remains a simple task. 
50 While rub-on labels certainly have large drawbacks, i.e., they cannot be used for annotating 
digital images, they embody the simplicity of annotating an image quickly with the necessary 
information. Sophisticated software, while capable of generating simple annotations, requires a 
high degree of skill and knowledge to navigate the complexity of options and functions to achieve 
what is, in the end, a simple task. Moreover, the previously available systems and methods do not 
55 promote interactivity with a user, neither in their output nor in their presentation. Thus, 
simplicity, interactivity and low cost continue as unsatisfied objectives for the process of 
effectively annotating visual digital material despite technologic improvements. 

Not only is most image manipulation software functional overkill for creating simple 
annotations, this software flattens images where the annotations are * fixed" to the image much like 
50 rub-on labels. The flattening of image annotations causes several problems that also existed with 
rub-on labels: editing difficulties, poor image quality, lack of interactivity and information 
loss. These problems are further illustrated below. 

Annotations are not easily edited in a flattened image. The process of editing a flattened 
image requires using the original image— often in a proprietary format— in the native environment of 
55 the authoring software. This process requires locating the original (not the presentation image 
currently in use) image or images— typically on a local hard drive-making the changes and then 
redistributing that image to the various publishing targets: Internet/WWW, paper-based copies, and 
so on. If the original image is lost then the annotations must be completed again from scratch. 
Those that have used this process— locating an image, making changes, then redistributing the 
'0 image— can attest to the time and frustration involved. 

In the previously available systems and methods, annotations when flattened become part of 
the raster-based (drawn with pixels) image as opposed to being stored as vector (drawn in true 
physical space) information. As the raster annotations are re-scaled (zoom in or out) their 
appearance often become incomprehensible. 
r 5 Flattening of annotations to an image means not only that the annotations cannot be scaled 

accordingly, it means that the annotations cannot be manipulated in other ways, such as, creating 
interactive presentations for the purpose of communicating a visual relationship or integrating the 
annotations into a learning assessment tool. Since the Internet has emerged as a viable medium to 
deliver educational materials, presentors are more often using the Internet to provide computer- 
10 assisted presentations of educational material. Moreover, providing computer-assisted 
presentations has become easier than ever with the advancements in technology, computer hardware, 
software and improvements in the Internet and World Wide Web as delivery a mechanism. For example, 
in an illustration of brain anatomy it may be necessary to illustrate the neurology and gross 
anatomy side-by-side. But it may also be useful to hide or turn off the gross anatomy in order to 
15 illustrate the neurology then turn the gross anatomy back on to illustrate the relationship (s) 
between the two groupings. This scenario could be solved with raster images, however, it would 
require three images— one with neurology, one with gross anatomy, and one with both. Thus, there 
is four times the effort to produce this basic level of interactivity. Additionally, If these 
images are being viewed on the Internet it would mean three times longer wait in addition to the 
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labor and disk space utilized in producing three images. As the interactivity of an educational 
Presentation increases the effort involved with raster images will grow exponentially. 

The fourth and possibly the most significant problem arising from flattened annotations is 
the loss of information. For example, in the situation of medical research and instruction, 

5 scientists, teachers, physicians, residents and students go to a network, such as the Internet, 
expecting to find resources on a particular topic by entering a keyword or phrase representing the 
subiect or title of their objective. In order for a resource to be found, information about that 
resource must be indexed or cataloged like the age-old library card catalog. 

Annotated images are one example of the valuable resources that need to be integrated into 

0 a catalog or index in order to be found and to realize their value. Annotated images offer more 
value "than the base image in that there is intellectual or authored content assigned to the 
reatures of the image providing instructive value beyond the image itself. The annotations are 
part of the content. In order to index the annotated image this and other 

information-metadata-about the image (subject, keyword, format, date created, copyright, etc.) must 

5 be cataloged. However, annotations that are flattened to the image are not available > for 
cataloging. Either the content of the annotations is lost or the annotations must be entered again 
into another system and associated with the image. This de-coupling of content from the unage and 
re-entry of the annotations into a separate storage system which is required when using_ the 
previously available systems and methods results in a more labor intensive, complex and disjoint 

0 procedure^^^ disadvantage to using a flattened image is the inability to allow multispecialty 
authoring. Multispecialty authoring is the ability to add visual annotations, stored as groups, 
according to authorship. Often it is necessary that several different individuals annotate the 
same image. For example, several different specialties in the medical field may need to annotate 

5 an x-rav image. Using a flattened image, this would be extremely difficult. 

5 an x "^J^erdrawbadk to flattened images is that it is difficult to modify annotated images to 
make them context appropriate. Annotated images often contain annotations that are not .appropriate 
for the persons viewing the image for a variety of reasons. For example, this might include 
information that is prohibited from being disseminated by privacy laws or simply information that 

0 is irrelevant given the audience. Removing or hiding from view the annotations from a flattened 
image is not efficient due to the fact that the annotations are embedded in the image, 
image 1 another drawback to the use of flattened images is the difficulty in reusing the 

annotated image. Reusing images in a variety of different mediums is an ^tractive option for 
authors. Authors will often decide to publish annotated image data to a variety of media. S ome 

5 will publish in traditional peer reviewed journals and textbooks and others will want to publish 
annotated material to the World Wide Web. Moreover, the context in which an image will appear may 
require that the content, both image and annotations, be presented differently. When working from 
a flattened image, a great deal work must be duplicated to provide suitable flattened images for 
each contextt^ThusT it is in the best interest of the system architect and the author to create 

0 an archivl iikage with associated annotations and store annotations as vector information or text 



Reuse (linking or referencing) enables authors to easily and accurately link information, 
and then maintain links across document revisions and system changes . Adhering to a reuse policy 
coulQ Potentially reduce storage costs, and reuse rather than duplication promotes s^haring of 

5 existing authored material rathlr than recreating it The traditional known *£™rtoyi^^MA 
reuse include print publication, color plates, 35 mm slides, and the many f orms of digit: al 
publication (e.g., PDF, HTML, etc.). Another form of reuse is in-system digital reuse of ^"ting 
information. For example, a user might add multiple sets of annotations to an image and then 
desireto activate or inactivate the various sets of annotations to customize the ^ge for use in 

.0 different contexts, such as on a world wide web page, in a print document, or in the portable 
document fo^t (PDFK previously available methods and systems are thus characterized by 

several disadvantages that are addressed by the present invention. The present invention 
minimizes, and in some aspects eliminates, the above-mentioned failures, and other problems, by 

.5 utilizing the methods and structural features described herein. 

BRIEF DESCRIPTION OF THE DRAWINGS 
The features and advantages of the invention will become apparent from a consideration of 
the subsequent detailed description presented in connection with the accompanying drawings in 

; 0 which: FIG . ! is a flow chart showing the steps carried out in accordance with one illustrative 

embodiment of the present invention. , _ 

FIG. 2 is a reproduction of a computer display showing the various features of one 

illustrative embodiment of the present invention. = o„_„*. 

FIG. 3A illustrates an example of an annotated image in accordance with one aspect of the 

55 present^ invention ^ strates ^ axm _ mb9MmA nature of the annotations in FIG. 3A in accordance with 

one aspect of ^present^nvention^ ^ ^ ^ ^ accordance M one illustra tive 

embodiment of the present invention. „,. h „_ 

'0 FIG. 5A and 5B illustrate the interactive nature of the annotations m accordance with one 

aspect o^the present .invention ^ ^ ^ ^ accordance with one illust rative 

embodiment of Uie P^Xg'ra^f A°ustrating the multispecialty annotation features provided by one 
*5 illustrative embodiment of the present invention. 

DETAILED DESCRIPTION OF THE ILLUSTRATIVE EMBOD IMENTS 
For the purposes of promoting an understanding of the principles in accordance with the 
invention, reference will now be made to the illustrative embodiments described herein. It will 
nevertheless be understood that no limitation of the scope of the invention is thereby intended. 
30 Any alterations and further modifications of the inventive features illustrated J*f*ein, £ n £j*? v 
additional applications of the principles of the invention as illustrated here an, 
normally occur to one skilled in the relevant art and having possession of this disclosure, are to 
be considered within the scope of the invention described and claimed. , an . rnil . 

The publications and other reference materials referred to herein to describe the backgrouna 
35 of the invention and to provide additional detail regarding its practice are hereby incorporated 
by reference herein. The references discussed herein are provided solely for their disclosure 
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prior to the filing date of the present application. Nothing herein is to be construed as a 
fuaaestion or admission that the inventors are not entitled to antedate such disclosure by virtue 
of orior invention. Further, it must be noted that, as used in this specification and the appended 
claims? tne singular forms "a, " "an, - and "the" include plural referents unless the context clearly 

5 dictate « n °^ 1 s e c r ^ i e n - g and claiming the present invention, the following terminology will be used in 

^^^usedhereln? 6 "co^risinff" "containing, - "characterized by ," and grammatical 

equivalwts thereof are inclusive or open-ended terms that do not exclude additional, unrecited 

D el ^ ent ^^^ s h g° e d d ^ e P4' f the min drawbacks which accompany the previously, available flattening 
imaae annotations results in a variety of undesirable side effects: repetition of work, increase 
in Authoring effort, increased organization requirements, increased complexity, difficulties to 
automate imfge cataloging, reduced instructional capability. All of the problems associated with 

5 the use of raster based images can either be eliminated or reduced substantially by not flattening 
the annotations to the image by the use of storing the annotations as vector based graphics . 

With these objectives in focus, the illustrative embodiments of the present invention will 
define the requirements of a digital non raster-based annotation architecture and annotating 
mlthSaology for digital images that will serve as a basis for use in a number of ft^wjV £2blv 

0 authoring tools, presentation programs, and cataloging systems. The solution which is desirably 
provided in accordance with one aspect of the present invention is to separate the annotation 
information from the image information and at the same time attach or store the annotation 
t n £°.S^ton with the imaae file as vector-based text information. This method makes the 
annexions and ^metadata^cceslible, foi Example accessible to a user performing text searching for 

5 pe^rinen? information, while still keeping the image and annotation ^formation l^*£n *h±Sh 
The features and advantages of the invention will be set forth in the description wnicn 
follows, and in part will be apparent from the description, or may be learned by the practice or 
the invention without undue experimentation. The features and advantages of the invention may be 
realized and obtained by means of the instruments and combinations particularly pointed out in the 

0 appended ^laiins invention contemplates a system and method that allows annotations \° be captured 
in a non-raster format. Because the annotations are stored in a vector file that is linked to the 
imaae file? the annotation will travel with the image information and the process of editing image 
annotations becomes much easier. As used herein, | "vector image" or -sector "'^if^f 

5 a araohic comprising shapes, curves, lines, and text which together make the image. These shapes, 
culvllf Unesfanu text can'be constructed 'using mathematical formulas or other instructions as is 
known in the art to describe them instead of defining a grid of pixels as is the case with raster 
or bitmaD imaae s . A vector image can be in a two or three dimensional format. ... 
or bitmap ^ages a vecro^ annotations it is not necessary to manage multiple original versions 

0 in a proprietary format or distribute multiple copies of the same image. The annotations remain 
accesf ible-at any time-f or editing in the published image (the one most easily ' J. e .Vik T^le it tne 
reverting to prior versions or copies. Thus, image annotation workflow is streamlined while at the 

Same t %SftS? g of i iSi dotations in accordance with the present invention in this way makes it 
5 possible for a computer to catalog the resource automatically by "looking into" "^resource itself 
for the annotations and metadata rather than requiring a person to enter this information into a 
separate system. Thus, the present invention' s. exemplary separation of annotations i of I an image 
simplifies and facilitates the automated cataloging of image resources improving the retrieval and 

*«~^ajSl?nCT. , ?SS5Sr.' and methodology for annotating digital images with vector 
annotations is shown in accordance with the principles of the present invention. The first 
illustrative step is to open an image file (110) to annotate. Typically, the image file is a 
raster based inage, for example a bitmap image and can be an image stored in one of many available 
formats sucn Is? 9 without limitation, JPEG, BMP, PNM, PNG, TIFF, and PPM. PNG as an image format 
.5 is^Seful because it is supported by most image manipulation programs and, more importantly, 
because the PNG file itself can be used as a storage container for other types of information in 

^^^irt^ic^y^s'lAes in a permanent storage medium such as on a hard drive ^ CD, DVD 
flash memory or other similar storage device. The image can stem from any number of sources 

JO includfng? without limitation, a scanned image, a digital Pnotpgraph a workcreated on a compute^ 
such as an architectural drawing, computed tomography, magnetic resonance image ox : any _other valid 
source for a digital image. The image can be in a two dimensional or three dimensional format. 

Once the 9 image has been selected and opened (110), the next : step is for .the > ^thcr to 
annotate the imaae (112). Typically, the step of annotating an image (112) can include several 

55 dSrrerent subsl^ff depending u^n the needs of the author. Generally, an annotation will inclu de 
one or more of the following: a region of interest, a pointer, and textual ^°^|°"; av u ^ c " d | 
symbol, a label and/or a caption. The visible portion of the annotation on the image may include 
rhf region of interest, the pointer and the symbol. The region of interest ^' P^ n ^ e | 0 ^ symbol may 
allow a medical educator, for example, to identify anatomical structures that convey relevant 

'0 information about that image. Each of these will be defined in more detail below. 

The region of interest is the visible portion of the annotation that is of interest. For 
example, in the medical field, a region of interest could be a feature or structure on an image 
example, in tne meoicai ™^ that conveys a clinical or research finding. While any manner to 
mar^the region y of inte'rest will Suffice, an author generally draws a point, line, or Polygon to 

15 indicate a region of interest. The region of interest may be described by a set of points ^that 
may define a polygon, polyline or set of points, for example. A polygon may be used when the 
re|ion of interest is a well-defined area, the polyline (or edge) may be used when the separation 
of regions is of interest and the points may be used when the interesting features are too small 

>0 t0 Pra ^ i e^nt e e n r 1 ?o S r S? annfflon is partially defined by the author and partially computed 
based on where the author initially places it For example, the author selects where the tail of 
the pointer should appear, and an algorithm. calculates the closest point on the region ^ 
to place the pointer tip. This dual mechanism for anchoring the pointer allows the author to make 
choices about the layout of visual information on the image, . without relying on a totally 

35 automated, and potentially unpredictable, layout algorithm. It is also within the scope of the 
present invention to utilize free from placement of pointers. 
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The textual information that is defined by the annotation methodology and includes the 
a,m,>,«i label and caption. Providing the ability to add textual information about the annotation 
fSSSh the author to consent or add their expert knowledge on contents of an image in the form of 
I l^mbol label Md caption. The comments may refer to a detail of the image or the annotated 

> iirJg^fas a whole. The symbol, label and caption are a set of information commonly used across many 

field %h b e Ut sy^o^ visual piece of the ^^^SSSJSZ 

embodiment of ^the present ^^^n^^e^ ymo^ ^ ^ ^ ^ ""VvTt-h^her 

of other annotations, without obscuring visual information or interfering with the other 
annotations. When the symbol is used in this manner, it may be used as a key to link the visual 
Annotation to the textual information. As mentioned, the symbol may be derived from a lexicon 
relating to the field in which the author is working. The symbol may be a lexicon specific piece 

> of textual information that allows the annotation to be linked to a larger body of information 
outside the imageT For authors who do not use predefined lexicons during the authoring process, 
the svmbol may be enough to match the annotation with external information. 

tne symoox my « phrase that defines the visual annotation. For medical purposes, 

this label mTy also Fe taken f rm a lexicon or vocabulary, which enables dictionary-style lookup 

) in the software implementation. The lexicon-specific piece of textual information allows the 
annotation to be linked to a larger body of information outside the image. For authors who do not 
use lexicons during the authoring process, the symbol may be enough to match the annotation with 
external information. The illustrative embodiments of present invention does not restrict or 
define lexicons because use of lexicons is the author's preference or institution's policy. If the 

5 label is drawn from a defined lexicon, it should at least be consistent across the author's work. 

' The caption is defined as a sentence or paragraph that describes the annotation The 

description may include references to other pieces of information that may be part of an index or 
hypertext system. The caption should not contain information about the image as a whole, which is 
handled through a constant non-visual annotation. ^ . _ _„ vv ,„ 

nanaxea tui.uuy annotation process, the author should also be able to determine the 

presentationattributes The presentation attributes define how the annotations should be drawn 
wnen rendered The visible* parts of the presentation attributes may also be interp reted 

differently depending on the medium (e.g. laser printer, journal article or web browser). The 
presentation attributes may include size, color, pointer type and tip lo .catiori. 

present the embodiments of the present invention, each of the attributes may have 

onlv three or four options presented to the user to provide better control over presentation and 
^notation ?euse All presentation attributes in the present invention l ma* be ' 9 ulde ^? e | *°£ t ^ e 
rendering and reuse of visual characteristics including fonts, sizes and colors. The Hypertext 

Markup gWj^~) t Sr i «SL*SS s 7z P eTttri W 4\e m^y C bl? without limitation small, default and 
large, for simple This option controls the size of the pointer and as sociat ed text gendered with 
the visual annotation. The options for annotation color may be, without liaji tation, 
"default" and "dark," for example. This option may control the color of the region of interest 
(polygon), the pointer and any text that is rendered as part of the annotation. The color that 
5 each of the three-color attributes map to may be defined in a style sheet. -arrow" and 

The oointer tvoe options may be, without limitation, "spot, line, pin, arrow ana 
"arrowhead, " for example? Other pointer types may be added, but these four *£" g£ 

illustrative foundation for the kinds of pointers that may appear with the region of interest . The 
style sheet and rendering software may control the details (appearance) of these Peters. 
0 In accordance with one illustrative embodiment of the 'present .invent ion ^ ^ the Pointer tip 

oDtion mav control where the tip of the pointer appears relative to the region of interest. ine 
options^ay include "center" and P "edge, " tor example. Using this attribute, . the ^do^ent of the 
present invention may determine the actual pixel location of the Pinter tip. The illustrative 
Embodiments of the present invention may alternatively utilize f ree form placement. 
5 Once the image has been annotated, the next step is to save the annotations and metadata, 

if present! as vector information linked to the image (114) . The term linking, in addition to its 
norma! meaning, also means, for the purposes of this application tosave thevector information 
inside the image file itself or as a separate file. Some image formats, such as PNG, allow tne 
vector information to be saved inside of the image file itself. as vector 

0 It will be appreciated that one advantage to saving the annotations and metadata as vector 

information is that vector based annotations improve the quality of image presentation because the 
annexions can ft* re-drawn or scaled dynamically based on their ^ation'^ within the geographic 
space of the image. Therefore, image annotations can be shown clearly at all scales as tne viewer 
rl-scales the presentation (zooms in or out) . In the same way that annotations .can be jcaled they 
5 can also be dynamically manipulated to create instructive and exciting interactive presentations, 
integrated into a learning assessment program, or other goal oriented • tasx. noas ible to 

In accordance with the illustrative embodiments of the Present invention, it ^ possible to 
store text information such as vector-based image annotations and metadata inside the image file 
along side the actual image information. The metadata includes any additional information about 
0 the Lage or annotations ?hat may be useful. For example, the metadata may ^^JStJS^l^ 
persons adding annotations to the image, including the date and t^e that ^e ann^ot^ions were 
performed. The metadata may also include patient information m the case of medical linages. ine 
metadata may also T include the names of persons who have viewed the image or annotations and the 

5 an if ^lri°ng\ h e^t 'information inside the image file along side the actual ^age ^rmation 

is not possible, the annotation can also be stored in a separate file from the ^ge with a 
relational mechanism, all in accordance with the illustrative embodiments of the present invention. 
This text information is not automatically displayed as a default by » ost ^^"^J^ 3 ^ 
visually hidden. However, this information is accessible to many programming languages for 

0 Interactive display, annotation drawing, publishing to multiple targets .and cataloging. In. this 
manner, storing metadata and vector-based annotations as text inside the image file, this 
information can more easily "travel" with the image information. mial . hrtrt 4 «. *- 0 storB 

While the vector information can be stored in any format, one preferred method is to store 
the vector information in the extensible Markup Language ("XML ") format This ^fh^ologyensures 

5 that annotations remain accessible as vector data, not embedded in the xmage, as well as maintain 
the links between the image and annotation information. It will be appreciated I that _ storing tne 
vector information in the XML format allows the annotations and images to become re usable. 
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Moreover, with vector-based linage annotations, management of multiple original versions in a 
oroorietary format or distribution of multiple copies of the same image is not necessary. 
Pr ° prie ^rther, in accordance with the illustrative embodiments of the present invention, the output 
ic, nor Platform specific. Rather, the output format may utilize the Scalable Vector Graphics 

> rsvl") format? which is an extension of the eXstensible Markup Language, (XML) specification. 
Metadata that includes visual annotations, author information, lexicons and infonoation related to 
the authoring sessions are stored within the file. SVG facilitates extensibility, interactive web 
viewing, and reuse. SVG also allows the annotations and visual expert knowledge U.e., labels and 
captions) to remain linked to the image, as opposed to embedding the annotations to the image . To 

) facilitate the interactivity of the annotated images, the illustrative embodiments of the present 
invention utilize Adobe's SVG plug-in (Adobe Systems, San Jose, California) for viewing annotated 
images jgie^In^rng^ ^ Qf ^ facilitat e S cross-media distribution Cross- 

media publishing is a term that defines a set of methods that allow source material to be collected 

5 at a single source in a manner allowing reuse and redistribution across multiple delivery channels 
such as the internet, electronic books, textbooks and presentations. For exa^le, ^ the medical 
content market development continues to be a thriving industry that ranges from standard textbooks 
and references to digital subscription services and web portals. In ° the J "ords, an image 
annotated using the present invention is easily transported from one form of media to another form 

) of media. invention has been developed for the cross media publishing and digital content 

authoring markets T is designed to integrate into existing systems for visually annotating fmages 
that are tT be used for publishing in textbooks, on the Internet as a subscription Continuing 
Education module > or : on CD ^ that m± ht be disp iayed on a computer screen that has 
been annotated pursuant to the an illustrative embodiment of the present invention as explained 
above This example is useful for understanding the different features of the illustrative 
embodiment o? the ^present invention and should not be construed as limiting in anyway. As can be 
observed? several regions of interest have been marked on the image- One region of interest, 

D indicated by reference numeral 118, is noted by the label 122 «Cyst" jfhich is connected to the 
T ^ 4 no hw a nft iTii-pr 120 Also, a caption 124 and symbol 126 for the regxon or 

inlerLf lif ca^be^Lerved 9 ?n e rhifmanner°'it wifl be appreciatfTthat the annotations are 
iselSl in conveying T information to the observer. FIG. 2 also exemplifies the advantageous use of 
arouDs and views in accordance with the present invention. , . . „ t m ^„~ 

groups ana g views 11 respe otively show an annotated image and the annotations without the image. 
The annotations shown in FIG. 3A show marked regions of interest with their respective pointers and 
labels As can be seen, the annotations are "overlaid" over the original i^ge as u? ™ in flti 
3A. FIG. 3B demonstrates that the annotations are not embedded in the < original o\it ^ are in iaci 
stored in a separate file that is preferably linked to the image file. The annotations are .stored 

0 in an image independent vector format for high-resolution display at all scales. .Note that the 
original image remains unedited and more importantly, no pixels of the original raster image were 
changed or edited illustrative embodiment of. the present invention, .^e separate 

annotation file may contain a digital signature of the image file in case the two files are 

5 separated As will be explained in greater detail below, reuse of the : image .is facilitated since 
the original image remains unchanged and the annotations remain linked to the g*<3?- 

It will be appreciated that because the annotations are not embedded into tne image, tney 
can be referenced, grouped (as shown in FIG. 2) and indexed for a variety of purposes. In 
adSitfonfwhfl^ C muitfp?e P annotations can be added to an image, not all of the annotations need be 

0 displayed at the option of the presenter, to create a context appropriate annotated image. Tnese 
multiple annotations can be interactive as will be explained below. . , ronHnn facilitates 

FIG. 4 is an illustrative example of the methodology of how the present in yention facilitates 
a Dluralitv annotations and groupings. The first step is to select and open an image (128) that 
ha? heln stored electronically. The author then is free to define a region of interest (130) and 

5 adl the* i^i^slSlf, and pointers (132) as desi red The ^hor £s «>en f ree to 

chose to add additional annotations (136). It should be noted that the author may ..ne adding 
annotations to an image already annotated by another person (referred to herein as multiuser 
tuthoring")\ This iT particularly true in a medical setting where several doctors may be adding 

0 aim0tat On°ce S tne'imagrhas^en annotated, the next step is to group or order the annotations 
hierarchically (136) The order is a character sequence that allows the annotations of the image 
to be organized in an outline format, allows the annotations to be grouped (or nested) logically 
and may impart priority (like the first annotation in the outline is the most ^ortant) . Th e 
o?de? is tJeaVed P as an annotation but is used to identify and set up the ' hierarchy n ^*5££«g 

5 annotations fall into. This piece of textual information is an ^visible annotation that links the 
pieces of textual information consisting of the symbol, label or caption ^othe Image. 
y In accordance with the illustrative embodiments of the present invention, , the textual 

information that is the order or grouping, is linked and r stored with the J-mage, much "lea tta 
chunks of data that are embedded within Portable Networks Graphics (PNG) format. This mature is 

0 similar to the concept of a table of contents. The textual information that defines the order or 
Ironing of the visual annotations is a constant, non-visual annotation always exists , at ^ the first 
nosition in the outline, and is a part of the information used to create the image' s metadata . 
P 031 ^ ^rda^ce with anothe/dlsirable feature of the illustrative <£°^***^™l™t 
invention, the region of interests can optionally be organized into '^ff^X/that allows 

«; iiin\ Context-aDoroDriate viewing of an image and related annotations is a feature tnar. aiiows 

5 tne innofationl In^n^age to 1 be turned on oroff for a particular audience or pr.8«micm. The 
annotation view attribute controls the visibility of an annotation because the annotations are 
separate from the image and are separate from each other. Thus, the view n attribute f=an fc urn 
annotations on/off in a context-appropriate manner. Depending on the context, . portions of 

0 annotations may be viewed in a presentation while other portions re^in hidden As presented «t 
step 140, saving the file with annotations as vector information linked to the image is carried out 
in accordance with the illustrative embodiments of the present invention. 

FIGS. 5A and 5B are exemplary of context appropriate viewing in accordance ™ 
illustrative embodiments of the present invention described herein. In i FIG. 5A, as can _be seen in 

5 the box 142, all of the annotations for this image have been selected and are being « displayed. As 
seen in FIG. 5B, the box 144 shows that only the first two annotations have been selected and 
displayed. It is important to note that the underlying image is the same for both of the annotated 
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images. That is, both of the FIGS. 5A and 5B use the same file for the underlying image. Because 
the annotations are saved in a separately from the image (not embedded in the image) , the 
annotations can be selectively displayed on the image. 

Desirably, in the illustrative embodiments of the present invention, an annotation and 
5 related textual information (i.e., label or caption) consist of discrete pieces of information 
that, when viewed, are interactive. Interactivity in this sense is defined as giving the viewer 
the ability to turn on/off annotated groups on the image. Annotations and associated textual 
information are viewed and controlled independently from the image. 

Likewise, reuse of the image is facilitated by providing an open "hook" to link the image 

L0 and related annotations to larger cataloging systems. The ability to reuse underlying annotated 
images for different purposes (i-e-r publication, web viewing or professional conferences) is an 
important improvement of the present invention over the previously available systems and methods. 
The present invention gives the author the ability to annotate an image once and reuse the 
annotations or the image with or without the previous annotations. Authors can store the archived 

L5 image with the linked annotations. Importantly, the images remain unaltered because the 
annotations are not embedded into the image. Therefore, the image remains in an archival format and 
can be reused for other purposes or applications. 

As explained previously, in accordance with the present invention, by adopting open standards 
such as XML and SVG in the illustrative embodiments of the present invention, authors have the 

10 ability to save images with the annotations linked to the images, in a structured format of XML 
(SVG) . The open and extensible features of SVG promote indexing of the image with associated 
annotations and textual information, thus allowing images and annotations to be catalogued in a 
database or asset management system. 

In the previously available systems and methods, the complexity of most graphical programs 

15 and the problems caused by flattening image annotations, there is often no way to relate or group 
annotations as can be done with the present invention. Most of these previously available 
graphical programs will allow the user to create any visual appearance desired. However, these 
programs are only interested in the appearance of things and do not keep track of the inherent 
structure, relationships or intellectual groupings of the annotations as does the present 

JO invention. 

For example, in gross anatomy there are many anatomical groupings. These groupings represent 
an intellectual categorization that can be visually illustrated. Thus, there are two valuable 
aspects to such groupings: visual and inherent intellectual structure. An author may group 
annotations by using color to create the visual relationships. With the previously available 

$5 pertinent software programs this is the end result. Other than the appearance of the image there 
is no way of knowing that (or working with) an annotation is part of one group or another. The 
structure of these groupings— which annotated feature belongs to which group—is lost when using the 
previously available systems and methods. In other words, it is not possible to interactively 
illustrate such relationships without retaining the intellectual structure of the annotations. 

0 Using the simple example provided above, using the previously available systems and methods it is 
not be possible to visually hide the gross anatomy so as to illustrate the relationship to 
neurology without retaining the information structure. Moreover, using the previously available 
systems and methods it is not be possible to dynamically integrate these relationships in a 
learning assessment tool by asking questions such as, "What group does the visible feature below 

5 to: gross anatomy or neurology?" 

In addition, in accordance with the illustrative embodiments of the present invention the 
retained structure of annotations could be used to automatically generate an image caption or a 
hierarchical legend of the annotated features. Without access to these relationships via a 
separation from the base image, as is done with the present invention, the dynamic and interactive 

0 features are not possible. 

FIG. 6 is a diagram showing the data flow carried out in accordance with an illustrative 
embodiment of the present invention. The first step is to extract the image data. The extractor 
(14 6) is an illustrative process that reads the digital information and assembles the auxiliary 
information for use by a human or computer (or any other data processing device) for annotation in 

5 accordance with the illustrative embodiments of the present invention. Digital information can 
also consist of color settings, grayscale levels, image pixel dimensions, or the type of image the 
user is requesting, i.e., TIF, JPEG, DICOM, etc. A human user or a wide variety of machine 
processes may initiate the process of extraction during the open image dialog. 

The next step is to organize the data. The organizer (148) acts upon the extracted 

0 information, and arranges the digital information to reflect the human user's conceptual 
organization in the illustrative embodiments of the present invention. The organization of the 
digital information reflects its origin or intended use by permitting the user to decide what the 
intended use will be. Organization includes, but is not limited to, a hierarchy, set, slices, 
channels, sequence and a single source of digital information (e.g., a single image) . For example, 

5 micro thin slices of tissue that contain the same cells, but are stained differently to identify 
different cell types in each slice. In this example, the organization is a single cross section 
of cells with each slice showing unique cell types. 

The next step is to construct the annotations. The constructor (150) is a machine aided 
human user process that allows visual annotation elements to be created manually by the user in the 

0 illustrative embodiments of the present invention. The constructor (150) represents a class of 
visual elements that includes, but is not limited to, a point, a line, a polygon, a plane and a 
cube. The constructor (150) annotation elements available to the human user are selected by a 
computer process based on applicability to the dimensions of the original digital information. 

The next step is to segment the data. In the illustrative embodiment, the segmentor (152) 

5 is a computer process that automatically (with no human intervention) identifies and detects visual 
features (i.e. edges, areas, planes, cubes, etc.) within the digital information, and automatically 
creates visual and non-visual annotations for those features. The segmentor (152) falls within the 
common definition of segmentation within the computer graphics industry. 

The indicator (154) is a machine aided human user process that allows visual indication 

0 elements to be created manually by the user in the illustrative embodiments of the present 
invention. The indicator (154) represents a class of visual elements that includes, but is not 
limited to, a spot, a string, an arrowhead, an arrow and a pin. Each indicator (154) has a core 
set of properties that include the anchor point (e.g., the tip of an arrow) and the properties that 
govern its shape for visual presentation. The indicator (154) allows the author in the process of 

5 annotation to focus the attention of a human user (viewer) , and visually ties feature relevant 
information to the annotation when it is not appropriate to display the information directly on the 
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annotation itself. The indicator (154) maintains the relationships between visual and non-visual 
annotation elements and image data (including image data which is ID, 2D, 3D, or 4D) i. 

The connector (156) is a visual or non-visual machine aided human user process that allows 
connection elements to be created manually by the user in the illustrative embodiments of the 

5 orient invention. A connection element enables the human user to define the relationship of two 
or more annotations. The definition of the connector (156) relationship determines how «f chine, 
such as a computer, presents the connection, and how the human user may interact with the 
connection and connected annotation elements. Connectors (156) include, but are not exclusive to, 
groups, views, rules and structural hierarchy of annotated features. For example in the case of 

0 a medical image, the carotid sheath contains the carotid artery, internal jugular vein and the 
va^s nerve^ The connector (156) defines the structural relationship between the carotid sheath 
Ind !he el^ents contained in the carotid sheath. The connector (156) provides the ability to 
define or select a context-appropriate view based on the groups of annotation. o1omori i-^ 
The descriptor (158) is a machine aided human user process that allows description elements 

5 to be created manually by the user in the illustrative embodiments of the present invention. A 
description element may be attached to any other annotation element, and appear visually with the 
annotation or as a dynamic visual element like an Interactive Visual Note. A description element 
m£v be free-form text, or may follow a coding convention or lexicon to constrain the description 
entry of the * taLS user. For example, in the case of a medical image the descriptor (158) may 

:0 contain a clinical note entered by an attending physician, a pathology report entered by a 
pathologist, or a caption that defines an aspect of the annotated region of interest. 
P The illustrative embodiments of the present invention provide particular advantages xn view 

of the provision of features related to Interactive Visual Notes. Some uses will find that IVN is 
the most T desirable feature of the present invention. IVN is supported by many illustrative 
^nrffmanta of t£e "present invention and provides, inter alia, interactive on/off functions. In 
^itiSn to Ssing t£e Sol for on/off presentation and the combination of symbol-label-caption 
lor generation of TegeC, in accordance with some illustrative embodiments of the present 
invention ^ the symbol-llbel-caption may also be used for extensive note taking on an annotatiori-by- 
Zotation basis without obscuring the visual presentation or requiring a separate "reporting 

(0 interlace Th% erTodilents of thepresent invention providing such advantageous features Provide 

,u that reports or extensive notes may be contextually presented on demand by the user while viewing 
the i£age and Lsociated annotations . This feature provides the advantage that the user does not 
have to interrupt his "visual" workflow to obtain text-based inforit^tion. Particular illustrative 
embodiments of tne present invention provided a handle or "hot-spot" at the end of the pointer or 

15 Irrow Twhich could be located anywhere) which triggers the dynamic display of a reporting window 
that maT have text, tables, charts and possibly other secondary information or even contain an 
i^eThat is used as a reference. This feature advantageously makes the given visual presentation 
nrn^h more rich while improving the user's efficiency and workflow. 

much more ^ricn ^■^ e ( ^ ) EO £J n « achine proceS s that mly or may not be aided by human user input to 
10 analvze and dlduce new visual and non- visual information from the pre-existing annotated 
fnromation using a set of defined rules in the illustrative embodiments of the present invention 
The deductor (160) is a mechanism for automating information manipulation L ^^^edica? 
process that may require a mix of human input and computer algorithms. For example, in a medical 
?mage a de^ucSSr (160) may count the number of each type of cell and the ^n distance between the 
15 cells in a slice of stained tissue. In the case of a medical image, the deductor (160) may create 
output that could be read and be integrated into an existing system for cell analysis. Th 
deductor (160) could also create output that is read and applied to a template in a publishing 

process. (162 . ± th machine process that creates the interactive visual interface 

50 based on the visual and non-visu^rannotated information for consumption and manipulation by a 
hu£an user in the illustrative embodiments of the present invention. The marmer in which the 
p^etentlr (162) creates the visual interface may be determined by viewing ^als, role or privilege 
C o the hUn user. Also, the presenter (162) may be constrained ^^f^^enera^e f visua! 
a computer system upon which it resides, which requires the presenter (162) _ to Srenerate , a e £.sual 

presented for ^g^^^e ^'S.^Siic.tian of ^^ed^ fs'merKy 

HE "shows how multiple authors may contribute annotations incrementally to ^e^age 
without variation to the original image, i . e embedding the ^t a V^rhA Tte 2^rv^a?4 
The primary care physician 164 is presented with a patient with a headache . The , pr una r y care 
physician 164 orders that an image 166 be taken of the affected area. ^ Pediatrician 168 receives 
65 the image 166 along with the initial clinical assessment made by the primary care .physician 1&4. 
AfterTeviewing the image 166, the pediatrician 168 annotates the pathology and adds clinical notes 

'^Stmr^errlngTora^ T^Peaiatkc neurologist 170 then receives the annotated image ,16 6A 
and aJsa^ltlon^r^lIatLo^s thereby creating annotated image 166B ^<^^i^ge 166B i| 

70 then sent back to the primary care physician 164 with the annotations of both the Patrician 168 
and the pediatric neurologist 170. The primary care physician can then view tne annotations 
interactively, that is, either separately or jointly. 4 „ vmt format is shown in 

An example of the structured output of vector information in the XML format is snown in 
AppendiTl? It should be understood that the structured output contained in Appendix 1 is provided 

75 for exemplary purposes only and should not be construed as limiting the present invention in 

anyway. followi examples illustrate the various applications of the present invention. The 
examples are for illustrative purposes only and should not be construed as limiting in anyway but 
instead should The taken as representative of the wide applicability of the present invention to 
80 many different fields and professions. 

^neurosu rgeon reviews a volume rendered set of MRI data that indicates the patient has an 
aneurysm The neurosurgeon visually annotates a region of interest and adds a clinical note that 
is linked to the region of interest. The neurosurgeon identifies a Previously undetected aneurysm 
85 and marks that region for consult with the neuroradiologist. The > annotated 

to, or checked back into radiology imaging system with the annotations and added expert content 
linked to the three-dimensional model. The surgeon calls the radiologist for a consult on the 
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„„, ^ a neurvsm nrior to sending the patient to surgery. The radiologist adds a clinical note that 

2E«£J? the ^dltional diseased region of interest without destroying the original information 
5S?f 5£ added bv th^sWeon. The neurosurgeon consults with the patient, outlining the second 
that was L the sirwiv . Other neurosurgeons and radiologists, with the appropriate 

5 SSSSioS »Y check "out S£ Usually annotated image data set for review as reference or further 
multi-user annotation 

fflnvtstigator proceeds with an experiment which involves l** 1 "^ ^V^acfc^ito °thl 

SJSS S^inaiSnal Sxf ace rendering that maps the neurotransmitters and cells that are affected. 
^ scientist visual annotates one or the P S ynaptic ribbons that is formed within the secondary 
neuron Mlwork and adds an expert interpretation of the s ynaptic interaction The scientist 

stored with the originating scientist's notes. 

I* Plant b iologist receives digital electron photographs/images (EM) of a stained tissue 



proceeding 

5 



A X chImist determines the chemical structure of a compound i that reduces the fat absorption 
of the investigation. 

i5 hPSEustsstrtJs: sssss "eras ss£ ^^^^HiffisVwa 

later be used for time-based comparisons of the same area or as supporting material in a iegai 
proceeding . 

50 ^contrac ting electrician receives a digital blueprint for wiring residential j^ing. 

performed or problems encountered , which are subsequently stored for review Dy cne general 

contractor and contracting electrician. 

70 ^homeowne r receives a digital blueprint from architect. While reviewing on-site progress 

70 the hom^ow^rT PP lie e s visual notes to blueprint for later f ^f^^ to^nvlj 

by all parties. 

TheTanale r of a road construction project opens a map of the worksite and visually outlines 
the areTs 6 ™ "bl excivat'Sf^d the areas of /concern like .^•"-^«£ < £^°£ knowledge^f the 

30 should be avoided. This underlying map of the worksite wxth the applied ^pert S& wnere not to 
project manager is given to the excavation crew for spatial guidance on wbere to ana wnere nor w 
Ixcavate. Annotations and visual notes can be created and applied tc 'layers g in a »y»tem where o„e 
layer is telecommunications, another layer outlines water and I sewer ^ lines or |l e ™ c . a ^ |a ? owe ^ 
lines. The annotations and visual notes are not embedded in the layers of images our remain in 

85 their original positions as the underlying images are changing. 
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Example 9 

A mineralogist opens a digital microscopic image of a mineral sample as part of a mineral 
(oil, mining) exploration project. The expert mineralogist visually annotates the image with 
shapes (polygons, lines, points) and associated text-based symbols and descriptions. The image and 

5 associated visual annotations are logged and stored in the enterprise system. This analysis 
resides as reference material for later investigation and subsequent review and annotation by 
senior investigators for directing the exploration investigation. In addition, the analysis may 
be archived and retrieved at a later time for exploration reconsideration. The visual annotations 
are designed to be linked to the image data set and can be linked to additional images as they are 

0 generated as part of the investigation. 
Example 10 

An individual author can open an image in the visual annotation software. The author can 
then identify a region of interest and outline the region of interest, place an arrow and label 
indicating some feature in or on the region of interest and assign a group to the collective (e.g., 

5 abnormal structures versus normal structures) and write a caption for the annotated region of 
interest. The annotated groups can be organized in a hierarchical fashion according to the 
author's outline (e.g., a table of contents). The author can continue to visually annotate 
features on the same image or a set of images without destroying the underlying image (s), or having 
the visually annotated structures collide with one another. At the time of publishing the author 

0 may select from the hierarchy of annotated regions of interest by turning off and on individual or 
groups of regions of interest and associated captions for output to a digital press or other 
publication media (e.g., WWW or CD-ROM). 
Example 11 

A physician viewing an image of a cyst that has been heavily annotated over time by multiple 

5 specialist's can obtain particular advantage from the Interactive Visual Note (IVN) feature of 
selected illustrative embodiments of the present invention. In embodiments of the present 
invention incorporating IVN, the physician can select a single region of interest that contains 
additional information regarding the region of interest. For example, of immediate interest may 
be a cyst for which two annotations are selectively displayed. Each annotation outlines the cyst 

0 margins indicating a change over time (one outline at an early date shows a smaller cyst than that 
at a later date) . At the end of each pointer for each annotation is a "hotspot." By moving the 
mouse pointer to that hotspot the user is dynamically presented a microscopic image of the 
pathology as well as a table reporting the microbiological/molecular findings. These results may 
be extensive and would, if not hidden as a default, take up the entire screen. But, these reports 

5 can be called up on demand while viewing the image, which is the main (in the case of this user) 
analytic medium. In contrast, previously available systems typically show the user the image and 
then the user must read the interpretation (in some of the illustrative embodiments of the present 
invention replaced by interactive visual annotations and brief notes, such as symbols-labels- 
captions) and view reports at separate locations. In accordance with selected illustrative 

0 embodiment of the present invention, the reporting or display of any related information can now 
be displayed or provided at the same location as the image, which improves the workflow of the 
user. 

Example 12 

The interactive visual note (IVN) feature of selected embodiments of the present 

5 invention provides physicians and healthcare support personnel with solutions to effectively and 
efficiently access and use the medical knowledge base across practice environments; facilities 
decision support and medical training. For example, healthcare specialists in the field 
administering small pox vaccines require the ability to collect visual image data of vaccinated 
individuals and add clinical findings that allow them to track the efficacy of the vaccination. 

0 The healthcare specialist in the field may annotate the affected region of interest (inoculation 
site) using a pointer, label or caption on the image and add a note to the annotations that 
supports the clinical findings. Additional annotations can be placed at the margins on the 
inoculation site indicating a change in scar formation over time (an outline at a later date 
shows a larger affected region of interest than that at a later date) . The medical specialist 

5 in the hospital setting receives the annotated images as a visual reference to develop a medical 
plan and reviews the field specialists' findings to determine if the inoculation was successful 
and adds an expert opinion of the findings to the annotated image data. Expanding on the above 
example, the field specialist reviews the medical specialist's expert findings and adds 
additional findings to the annotated region of interest such as adverse drug interactions 

D observed in the field or changes observed in the inoculation site. The information remains 
linked to the visually annotated regions of interest and can be dynamically presented to the 
user as an IVN when the mouse cursor is in the "hot-spot". This collection of information, 
residing in a consistent user interface, can be reviewed by the appropriate governing body (for 
example, Centers for Disease Control) for additional indications or used to identify populations 

5 at risk. Field and medical specialists and officials who track small pox inoculations review 
medically relevant information in a consistent interface. 
Example 13 

Visually annotating a region of interest and adding a clinical note to indicate a 
clinical finding and linking that information to the patient record is also advantageously 

) included in selected embodiments of the present invention, which can also function as a tool for 
decision support by the user. For example, a primary care physician located in a rural clinic 
treats a patient for a neck mass. The patient does not respond to antibiotics so the primary 
care physician requests a clinical and radiology consult and at a tertiary care facility. The 
radiologist visually annotates a region of interest (neck mass) and also visually annotates the 

5 abnormal or affected anatomy surrounding the neck mass. The radiologist calls for a surgical 
consult. The surgeon identifies and visually annotates an additional region of interest but 
also adds a clinical note to clarify the findings. The surgeon consults with the radiologist 
prior to surgery on the additional findings that grouped according to the surgical grouping. 
The radiologist's findings are grouped according the radiology group and do not collide with the 

) surgeons findings. Continuing this example, the surgeon removes the neck mass and sends it to 
pathology for testing. The pathologist visually annotates the histopathology and indicates the 
regions of interest that correspond to the CT regions of interest verifying the findings of the 
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radiologist and the surgeon. The pathologist's findings can also be contained in the 
interactive visual note along with the clinical findings of the radiologist and surgeon. The 
visual annotations, clinical notes and pathology report is contained in one record that can be 
viewed by the primary care physician in the rural clinic. The clinical case becomes a clinical 
5 reference for future congenital neck mass diagnosis. 
Example 14 

The visual annotation and knowledge representation features of the illustrative 
embodiments of the present invention can improve the delivery and quality of healthcare in the 
field environment. By leveraging the capability to transmit data using low bandwidths, vital 

10 medical information and essential medical expertise can be shared regardless of location and 
made available as far forward in a military theater of operations as necessary, without 
increasing the logistical footprint. This feature is particularly advantageous for deployed 
forces operating in an austere environment and a geographically distant theater supporting 
combat or humanitarian assistance operations where certain medical specialties may not be 

.5 available. For example, a medic can capture visual information and annotate affected regions of 
interest in the field and send it to a central surgical hospital for immediate consult and 
triage. The medical specialist in a surgical facility can make a decision to transport the 
patient and at the same time, add a clinical note indicating initial findings for the patient 
that can be reviewed by the intake physicians. The ability to collect clinical notes among 

!0 healthcare providers at all levels, ensures consistency in presentation of complex medical 

information. Providing an interface that medical professionals can use across skill levels and 
practice environments simplifies the medical decision making process between hospital and 
clinics to deployed forces and improve diagnosis, treatment, and evacuation decisions. Improved 
medical decision support can be critical on-board deployed ships, for example. By offering 

!5 improved diagnosis, the illustrative embodiments of the present invention can prevent the 

unnecessary evacuation of personnel to medical facilities when they otherwise could be treated 
on-board ship. 

From an understanding of the foregoing, it will be appreciated that the present invention 
advantageously allows: (1) A region of interest to be specified within an image using a raster 
10 independent notation, and promote the capture of associated textual information; (2) For each 
annotation to be easily manipulated (moved, sized, deleted) independently from other annotations 
(non-embedded annotations) ; (3) Annotations to be grouped using user defined group names 
(hierarchical groupings); (4) Annotations to be presented using user defined preferences 
(context appropriate viewing) ; (5) Multiple images to be viewed and annotated concurrently 
;5 (multispecialty authoring) ; (6) Annotations to be saved in a simple format, for example XML, 

that may be permanently associated with the image; and (7) Image and annotations can be exported 
as a "flat" rasterized image for use in HTML pages, digital slide presentations and publications 
(providing cross -media capability) . 

Appendix 2, set forth below, contains an illustrative example of one embodiment of 
0 programming code that can be executed on a computer in accordance with the features of the 

present invention. It should be understood that the code in Table 2 should not be construed as 
limiting of the present invention in anyway. 

It is to be understood that the above-described arrangements are only illustrative of the 
application of the principles of the present invention. Numerous modifications and alternative 
5 arrangements may be devised by those skilled in the art without departing from the spirit and 
scope of the present invention and the appended claims are intended to cover such modifications 
and arrangements. Thus, while the present invention has been shown in the drawings and 
described above with particularity and detail, it will be apparent to those of ordinary skill in 
the art that numerous modifications, including, but not limited to, variations in size, 
0 materials, shape, form, function and manner of operation, assembly and use may be made without 
departing from the principles and concepts set forth herein. 
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<IAT> 
<canvas> 

<border color="black n > 0.02 0.02 0.02 0.02 </border> 
</canvas> 
5 <annotations> 

<roi type= M area" order="2" > 
<views> NEW </views> 

<authors last="John Doe* revision="0"> </authors> 
<code> </code> 
10 <symbol> MCF </symbol> 

<label> Middle Cranial Fossae </label> 
<caption> </caption> 
<cs_class> </cs__class> 
<cs_tumor > < / cs__tumor > 
15 <cs_jnode> </csjiode> 

<cs__metastasis> </cs_metastasis> 
<cs_note> </cs_note> 

<vertexs> 0.08056,0.66667 0.05833,0.58125 0.06944,0.50208 0.14444,0.38333 0.20278,0.36875 
0.26389,0.36458 0.32222,0.37500 0.38056,0.40000 0.43333,0.43958 0.43889,0.42500 0.45833,0.41458 
20 0.48889,0.40417 0.51667,0.40833 0.54167,0.40625 0.56944,0.42292 0.59444,0.44375 0.61944,0.43542 
0.65556,0.40208 0.69722,0.37917 0.75278,0.36875 0.81389,0.37500 0.89167,0.39792 0.91944,0.43750 
0.95278,0.53958 0.95278,0.59792 0.93889,0.65417 0.92222,0.68750 0.89722,0.72083 0.86944,0.71250 
0.83056,0.68542 0.73333,0.62292 0.64444,0.56458 0.56389,0.54583 0.49444,0.53958 0.41944,0.54583 
0.34722,0.56875 0.29722,0.59792 0.17778,0.67292 0.14444,0.71250 0.11667,0.71458 </vertexs> 
25 <pointer head= M l" point="l" tail=" 0 . 08611, 0 . 61042" shape= n none" text= n symbol " > </pointer> 

<color> black </color> 
</roi> 

<roi type="area* order= ■ 2 . 5 * > 
<views> NEW </views> 
30 <authors last= B John Doe" revisions "0"> </authors> 

<code> </code> 
<symbol> SOF </symbol> 

<label> Superior Oribal Fissure </label> 
<caption> </caption> 
35 <cs_class> </cs_class> 

<cs_tumor> </cs_tumor> 
<cs_node> </cs_node> 
<cs_metastasis> </cs_metastasis> 
<cs_jnote> </csjiote> 

10 <vertexs> 0.43333,0.43958 0.44444,0.42708 0.45556,0.42292 0.46389,0.43125 0.45833,0.44583 

0.45556,0.45625 0.44444,0.46667 0.43611,0.46667 0.43056,0.45000 </vertexs> 

<pointer head= n 5" point=»5" tail=*0 .49722, 0.46667- shape=°line n text= n symbol" > </pointer> 
<color> black </color> 
</roi> 

15 <roi type= fl area" order ="2.4" > 

<views> NEW </views> 

<authors last="Jane Doe" revisions" 0"> </authors> 

<code> </code> 

<symbol> FS </symbol> 
>0 <label> Foramen Spinosum </ label > 

<caption> < /caption> 

<cs_class> </cs_class> 

<cs — tumor> </cs_tumor> 

<cs_node> </cs_node> 
>5 <cs_metastasis> </cs_metastasis> 

<cs_note> </cs_note> 

<vertexs> 0.31389,0.52708 0.32222,0.51667 0.33611,0.51667 0.33889,0.52708 0.33056,0.53542 
0.31667,0.53542 </vertexs> 

<pointer head="auto n point="0 M tail=" 0.26944, 0 .52500" shape="line M text=" symbol" > </pointer> 
*0 <color> black </color> 

</roi> 

<roi type="area" order="2.1" > 
<views> NEW </views> 

<authors las t= "John Doe" revisions n 0 " > </authors> 
15 <code> </code> 

<symbol> FL </ symbol > 

<label> Foramen Lacerum </ label > 

<caption> The foramen lacerum is an artifact of a dried skull. In life, nothing is transmitted 
through it vertically and it is closed by a plate of cartilage. </caption> 
0 <cs_class> </cs_class> 

<cs_ tumor > </cs_ tumor > 
<cs_node> </cs__node> 
<cs_metastasis> </cs__metastasis> 
<cs_note> </cs_note> 

5 <vertexs> 0.40278,0.52917 0.41111,0.51875 0.42500,0.50833 0.44444,0.50417 0.46111,0.50625 

0.46111,0.51875 0.45000,0.52708 0.42778,0.53333 0.40833,0.53542 </vertexs> 

<pointer head= M auto" points" 5° tails- 0 .49444, 0 . 51667 0 snap e= ■ line ■ texts "symbol" > < /pointer > 
<color> black </color> 
</roi> 

0 <roi type="area" orders" 3. l n > 

<views> NEW </views> 
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^authors lasts "Jane Doe* revisions" 3 "> 

<author names "Jack Doe" revisions" 1"> 

<label> Cribriform Plate </label> 
<color> red </color> 
5 </ author > 

<author name=" John Doe" revisions "0 B > 
<label> Cranial Plate </label> 
<color> white </color> 
</author> 
10 </ author s> 

<code> </code> 
<symbol> CP </symbol> 
<label> Cribriform Plate </label> 
<caption> </caption> 
L5 <cs_class> </cs__class> 

<cs_tumor> </cs_tumor> 
<cs_ node> </cs^node> 
<cs_metastasis> </cs_metastasis> 
<cs — note> </csjiote> 

>0 <vertexs> 0.47778,0.27083 0.49444,0.23542 0.51111,0.24792 0.51667,0.26667 0.52778,0.24583 

0.54167,0.23958 0.56111,0.27708 0.55556,0.30417 0.54722,0.32708 0.53333,0.34583 0.50278,0.34167 
0.48889,0.32083 0.48611,0.29583 </vertexs> 

<pointer heads "auto* points" 6" tails n o . 59167 , 0 .27500" shapes "line" texts » symbol n > </po inter > 
<color> black < /color > 
15 </roi> 

<roi types ■ ar ea " orders ° 2 . 2 " > 
<views> NEW </views> 

<authors lasts "Jane Doe" revisions "0"> </authors> 
<code> </code> 
JO <symbol> FO </symbol> 

<label> Foramen Ovale </label> 
<caption> </caption> 
<cs_class> </cs_class> 
< cs_tumor > < / cs_tumor> 
*5 <cs_jiode> </cs_node> 

<cs_metastasis> </cs_metastasis> 
<cs_note> </cs_ note> 

<vertexs> 0.34444,0.50417 0.36389,0.49375 0.37500,0.48958 0.38889,0.48750 0.39444,0.49167 
0.39444,0.49583 0.39444,0.50417 0.39167,0.51250 0.38056,0.52083 0.36944,0.52500 0.35556,0.52500 
\0 0.34444,0.52083 0.33889,0.51250 </vertexs> 

<pointer heads" auto" points" 0" tail=° 0.3 027 8,0 .47083" shapes" line" text =" symbol M > < /pointer > 
<color> black </color> 
</roi> 

<roi types "area" orders" 2. 3" > 
.5 <views> NEW </views> 

<authors lasts" jane Doe" revisions" 0"> </authors> 

<code> </code> 

<symbol> FR </symbol> 

<label> Foramen Rotundum </label> 
■0 <caption> </caption> 

<cs_class> </cs_class> 

<cs_tumor> </cs_tumor> 

<cs_node> </csjiode> 

<cs_metastasis> </cs_metastasis> 
5 <cs_ note> </cs_note> 

<vertexs> 0.39444,0.43958 0.40556,0.43958 0.41389,0.44167 0.42778,0.44792 0.43056,0.46042 
0.41667,0.45833 0.40278,0.45417 0.39444,0.44792 </vertexs> 

<pointer head="0" point="0 M tails«0 . 34722, 0 .42292" shape= M line" text= tt symbol" > </pointer> 

<color> black </color> 
0 </roi> 

<roi types "area" orders" 1« > 

<views> NEW </views> 

<authors lasts "John Doe" revisions B 0 B > </authors> 

<code> </code> 
5 <symbol> PCF </symbol> 

<label> Posterior Cranial Fossae </label> 

<caption> </caption> 

<cs_class> </cs_class> 

<cs_tumor> </cs_tumor> 
0 <cs_node> </cs_node> 

<csjmetastasis> </cs_metastasis> 

<cs_note> </cs_jnote> 

<vertexs> 0.50000,0.88125 0.65833,0.87292 0.75278,0.83125 0.85000,0.76875 0.88333,0.74167 
0.76944,0.65417 0.72222,0.63333 0.69167,0.60208 0.60556,0.55208 0.51111,0.54792 0.41389,0.54792 
5 0.34722,0.57708 0.26944,0.62708 0.18056,0.68542 0.14722,0.74167 0.18889,0.78542 0.23611,0.82083 
0.34444,0.86042 </vertexs> 

<pointer head="l4" point="14" tails»0. 17500, 0.73542" shape="none" texts " symbol " > </pointer> 
<color> black </color> 
</roi> 

0 <roi type= "area" order* "1.1" > 

<views> NEW </ views > 



WO 2004/057439 



- 13 - 
Appendix 1 



PCT7US2003/017138 



-cauthors last="John Doe" revision= n 0"> </authors> 
<code> </code> 
<symbol> FM </symbol> 
<label> Foramen Magnum </label> 
5 <caption> </caption> 

<cs_class> </cs_class> 
<cs_tumor> </cs_tumor> 
<cs_node> </cs_node> 
<cs_metastasis> </cs_metastasis> 
0 <cs w note> </cs_note> 

<vertexs> 0.50556,0.61667 0.52500,0.62083 0.54444,0.63333 0.56944,0.65208 0.58333,0.65833 
0.58889,0.67917 0.60556,0.68958 0.60278,0.72917 0.58611,0.74792 0.55556,0.76667 0.53056,0.77708 
0.50000,0.78542 0.47222,0.78125 0.44722,0.76458 0.42222,0.75208 0.41389,0.73750 0.41111,0.71875 
0.41111,0.69583 0.41389,0.68333 0.42222,0.67083 0.45278,0.64167 0.47778,0.62500 </vertexs> 
5 <pointer header/* point« B 17" tail=-0 .43056, 0.71458" shape= B none" text= " symbol " > </pointer> 

<color> #ffffff </color> 
</roi> 

<roi type="area B order= w 3 ,! > 
<views> NEW </views> 
0 <authors last="tfohn Doe" revisions B 0 n > </authors> 

<code> </code> 
<symbol> ACF </symbol> 

<label> Anterior Cranial Fossae </label> 
<caption> </caption> 
5 <cs__class> </cs_class> 

<cs_tumor> </cs_tumor> 
<cs_node> </cs_node> 
<cs_metastasis> </cs_metastasis> 
<cs_note> </cs_note> 

0 <vertexs> 0.35278,0.12917 0.46111,0.11042 0.50278,0.12083 0.53889,0.11458 0.63056,0.12083 

0.70000,0.13958 0.82222,0.25417 0.85556,0.31667 0.87778,0.35833 0.87222,0.37708 0.75833,0.35625 
0.68333,0.37083 0.63889,0.39583 0.62222,0.41458 0.60000,0.42083 0.56944,0.40208 0.51389,0.39375 
0.45278,0.40208 0.43333,0.41042 0.41944,0.41458 0.36944,0.38125 0.31111,0.35833 0.23611,0.34792 
0.18611,0.36042 0.15556,0.35417 0.20278,0.25000 0.26667,0.17917 </vertexs> 
5 <pointer head="25 B points B 25* tail= B 0 .20556, 0 . 28333" shape="none" t ex t =" symbol " > </pointer> 

<color> black </color> 
</roi> 
</ anno tat ions> 
</IAT> 
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source iat . antptr . tcl 
source iat.antio. tcl 
source iat.antsvg. tcl 

LO 

namespace eval iat: rant { 

variable TRACE 0 

variable next_nsid 1 
L5 variable rawkey 1 

variable rawsave 0 
~# this assumes roi pts < 1000 

# see ant_create_jpointer . . . 
variable autoptr 1000 

20 variable thisptr 1000 

variable precmd d ■ 
variable ord2key 
variable leaf_id 0 

>5 

# all annotations 
variable view "ALL" 

# active annotation 
30 variable antkey 0 ■ 
variable order 

variable point 

variable points [list] 

variable head 
35 variable heads 

variable verts 
variable tails 
variable dSYMs 
variable dPTRs 
10 variable kind "none" 

variable color "default" 
variable code 

variable symbol 9 " 
variable label " * 
15 variable caption n • 
variable cs_class " B 
variable cs__ tumor ■ " 
variable cs_node - ■ 
variable cs_metastasis M ■ 

50 

array set heads [list] 
array set verts [list] 
array set tails [list] 
array set dSYMs [list] 

35 



variable 


fillcolor 




variable 


linecolor 




variable 


styleColorLight 


#FFF 


variable 


styleColorDefault 


yellow 


variable 


s ty leColorDark 


#000 


variable 


s ty leFontName 


helvetica 


variable 


styleFontSmall 


28 


variable 


styleFontDefault 


38 


variable 


styleFontLarge 


48 



} 

'0 namespace eval iat: :antOLD { 

# flags 

variable channels " " 

# annotations 

'5 variable polygons 
variable canvas 
variable of fsetx 0 
variable offsetY 0 
variable imagex 0 

10 variable image Y 0 
variable roiKey 
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iat . ant . txt_ 

# Copyright (c) 2001, university of Utah 

# All rights reserved. 
# 

5 # iat. ant. tcl 
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variable pointsDirty 0 
variable symbolDirty 0 
variable points 
variable sectors 
variable point 
variable rawlD 
variable select 
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variable orders 
10 variable kinds 

variable symbols 

variable labels 

variable captions 

variable centers 
15 variable pointers 

variable sizes 

variable colors 

# not part of methodology - only presentation ??? 
variable views 
20 variable sorls 

variable pointerPoints 
variable symbolPoints 



variable order 
25 variable kind 

variable symbol 

variable label 

variable caption 

variable center 
30 variable pointer 

variable size . 

variable color 

variable symbol Point 

variable view 
35 variable sorl 

# calculated. . . 
variable fillcolor 
variable linecolor 
30 variable pointer Point 
variable angle 

variable orderToKey 

15 variable callbackSelect 

set callbackSelect "noop' 1 



variable callbackDeselect 
set callbackDeselect a noop B 

50 

set roiKey ■ ■ 
set rawlD 1000 
set points [list] 
set select "NONE" 
55 set imageX 100 
set image Y 100 



variable styleColorLight #FFF 

variable styleColorDefault yellow 

50 variable styleColorDark #000 

variable styleFontName helvetica 

variable styleFont Small 28 

variable styleFontDe fault 38 

55 variable styleFontLarge 48 



#font create LABEL -family arial -size 32 



70 #package require iat.roi.svg 

proc iat : : ant : : next_nsid { } { 
variable next_nsid 
return [incr nextjisid] 

'5 ) 



proc iat: : ant: : proc { ns cmd args } { 
variable TRACE 

if {$ TRACE} { puts -iat: : ant: : proc: $ns $cmd $args" } 

\0 

variable antkey 
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variable color 
variable inview 
variable code 

variable symbol 
variable label 
variable caption 
variable cs_ class 
variable cs__tumor 
variable cs^node 
variable cs_metastasis 
variable cs_note 



switch $cmd { 

"configure" { 

#puts " cmd = configure: $args" 
foreach (key value} $args { 

#put8 " key = $key & value = $value" 
switch — $key { 
* -canvas" { set_ canvas $ns $value } 
■ -cmdcanvas " { set_cmdcanvas $ns $ value > 

"-size" { set__image_size $ns $value } 
"-offset" { set_image_of fset $ns $value } 
"-select" { set_select_mode $ns $value > 

> 

} 

> 

"cget" { 

#puts " cmd = cget: $args" 
switch — [lindex $args 0] { 

"-offset" { return [get_image_of f set $ns] > 

"-size" { return [get_image_size $ns] } 

} 

} 

"begin" { 

switch — [lindex $args 0] { 

"canvas" { precmd $ns canvas } 
"annotations" { precmd $ns annotations } 

} 

> 

"end" { 
> 

"close" { 

return [ant_close $ns] 

} 

"create" { 

#puts " cmd = create: $args" 
#ant_create [lindex $args 0) 
switch — [lindex $args 0] { 

"roi" { return [ant_create $ns [lindex $args 1] ] } 
"vertex" { return [ant_vertex_add $ns [lindex $args 1]] } 
"vertexs" { return [ant_vertexs_add $ns [lindex $args 1]] } 
"pointer" { return [ant_create_pointer $ns [lindex $args 13 [lindex $args 2] [lindex $args 

1 } 

> 

> 

"delete" { 

#puts " cmd - delete: $args" 
switch — [lindex $args 0] { 
"ptrvert" { return [ant_delete_ptrvert $ns [lindex $args 1] [lindex $args 2]] } 
"pointer" { return* [ant_delete__pointer $ns [lindex $args 1]] } 
"vertex" { return [ant_delete_vertex $ns [lindex $args 1] ] } 
"active" { return [ant_delete $ns active] > 
"annotation" { return [ant_delete $ns [lindex $args 1]] } 
default { return [ant_delete $ns [lindex $args 1]] ) 
} 

#ant_delete $ns [lindex $args 0] 

} 

"deselect" { 

ant_deselect $ns 

} 

"draw" { 

#puts " cmd *= draw: $args" 
switch — [lindex $args 0] { 

"segments" { return [ant_draw_segments $ns] > 

"vertexs" { return [ant_draw_vertexs $ns] } 

"active" { return [ant_draw $ns active] ) 

"all" { return [ant_draw_all $ns) ) 

default { return [ant_draw $ns [lindex §args 0]] } 

) 

} 

"dump" { 
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ant__dump $ns 0 

} 

"dump_keys* { 

ant_dump_Jceys $ns 

5 ) 

0 dump — svg 0 { 

ant_dump_svg $ns 0 

) 

•erase" { 

LO #puts ° and = draw: $args B 

switch — tlindex $args 0] { 

"all" { return [ant_erase_all $ns] } 
default { ant_erase $ns [lindex $args 0] > 

) 

L5 } 

"insert" { 

#puts * cmd = insert: $args" 
switch — [lindex $args 0] { 

"vertex" { return [ant_insert_vertex $ns tlindex $args 1] [lindex $args 2]] } 
>0 "ptrvert" { return (ant_insert_ptrvert $ns [lindex $args 1) [lindex $args 2] 



r lindex $args 3]] } 
} 



} 



"kind" { 

25 ant_kind $ns 
} 

•load" { 



ant_load $ns [lindex $args 0] 



} 

30 "make" { 



switch — [lindex $args 0] { 

"active* { return [antjnake $ns active [lindex $args 1]] } 
"all" { return [ant_make_all $ns [lindex $args 1]] } 
"svg" { return [ant_make_svg_all $ns [lindex $args 1]] } 
35 ) 
> 

"move" { 

#puts B cmd = move: $args* 

switch — [lindex $args 0] { 
10 "delta" { return [ant_move_ant_delta $ns [lindex $args 1J 3 } 

"vertex* { return [ant_move_vertex $ns [lindex $args 1] [lindex $args 2]] } 
"head" { return [antjnove_ptr_head $ns [lindex $args 1] [lindex $args 23] } 
"ptrvert" { return [ant_move._ptr_vert $ns [lindex $args 1] (lindex $args 2] 

[lindex $args 3]] } 

15 "tail" { return [ant_move_ptr_tail $ns [lindex $args 1] [lindex $args 2]] > 

> 

} 

"reacLcmds" { 

return [ants_reacLcmds $ns [lindex $args 0]] 

50 } 

"parse" { 

return [ants_parse $ns [lindex $args 0] ] 

> 

"point" { 

55 ant_jpoint $ns [lindex $args 0] 

} 

"points" { 

ant_points $ns 

} 

50 "pointer" { 

#puts ■ cmd a move: $args* 
switch — [lindex $args 0] { 

"style" ( return [ant_ptr_style $ns [lindex $args 1] [lindex $args 2]] ) 
"pin" { return [ant_jptr_pin $ns [lindex $args 1] [lindex $args 2J] } 
55 "symbol* { return [ant_ptr_symbol $ns [lindex $args 1] [lindex $args 2]] } 

> 

) 

"save" { 

ant_save $ns 

10 > 

"select" { 

return [ant_select $ns tlindex $args 03] 

} 

"get" { 

75 #puts " cmd = get: $args" 

switch — [lindex $args 0] { 

"key" { return $antkey > 
"color" { return $color > 
"code" { return $code ) 
10 "inview* { return $inview } 

"symbol" { return $symbol > 
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-label- { return $ label } 
"caption" { return $caption } 
"cs_class" { return $cs_class } 
"cs_tumor" { return $cs_tumor } 
"csjiode" { return $cs_node } 
°cs__metastasis" { return $cs_metastasis } 
"csjaote" { return $cs_note > 
default { return $antkey ) 
) 

} 

"set" { 

#puts " cmd = set: $args" 
switch — [lindex $args 03 { 

#"head" { return [ant_set_pointer $ns t lindex $args 1J) } 

"color" { return tant_set_color $ns [lindex $args 1]] ) 
"order" { return [ant_set__order $ns [lindex $args 1]] ) 
"view" { return [ant__set_view $ns [lindex $args 1]] > 
"inview" { return [ ant__set_inview $ns [lindex $args 1]] ) 
"code" { return [ ant_.se t_code $ns [lindex $args 1)] > 
"symbol" { return [ant_set_symbol $ns [lindex $args 1]] } 

"label" { return [ant_set__label $ns [lindex $args 1]] } 
"caption" { return [ant_set_caption $ns [lindex $args 1]] } 
"cs_class" { return [ant_set__cs_class $ns [lindex $args 1)1 } 
"cs__ tumor" { return [ant_set_cs_tumor $ns [lindex $args 1]] } 
"cs_node n { return [ant_set_cs_node $ns [lindex $args 1]] } 
"cs_metastasis" { return fant_set_cs_metastasis $ns [lindex $args 1]) > 
"csjiote" { return [ant_s'et_cs_note $ns [lindex $args 1]] } 

) 

) 

"update" { 

#puts " cmd = set: $args" 

switch — [lindex $args 0] { 1 
"view" { return [ant_update_view $ns] } 

> 



} 



default { • 

puts "ERROR unknown command = $cmd" 

} 

) 

0 

return {} 

) 

proc iat: :ant: :precmd { ns pre } { 

5 

variable precmd 

upvar #0 [join [list [namespace current] $ns cmdcanvas] ::] cmdcanvas 

0 switch $pre { 

"canvas" { set precmd $ cmdcanvas } 

"annotations" { set precmd [join [list [namespace current] $ns ] ::] } 
default ( 

puts "ERROR unknown precmd = $pre" 

5 } 
) 

} 

proc iat : : ant : : create { args } { 
0 variable TRACE 

if {$ TRACE) { puts " iat :: ant :: create : $args M } 

set nsid [next_nsid] 

5 set ns [namespace current] : :ants$nsid 

namespace eval $ns { 
variable select_jnode annotation 
variable cmdcanvas 
0 variable canvas 

variable offsetx 0 

variable offsetY 0 

variable imageX 0 
variable imageY 0 
5 variable orders 

variable polys 

variable aheads 

variable averts 
variable atails 
3 variable adSYMs 

variable adPTRs 
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variable kinds 

variable colors 

variable inviews 

variable codes 
5 variable symbols 

variable labels 

variable captions 

variable cs_classs 

variable cs_tumors 
.0 variable cs_nodes 

variable cs_metastasiss 

variable cs_notes 

array set aheads [list J 
.5 array set averts [list] 

array set atails [list] 
array set sdSYMs [list] 
) 

:0 set cmd "proc [namespace current] : rants $nsid { cmd args > (eval [namespace current] : :proc ants$nsid 

\$cmd \$args}° 

namespace eval : : $cmd 

eval "[namespace current] : : ants $nsid configure $args" 
: 5 ant_cr ea t e_de f aul t s 

return [namespace current] : :ants$nsid 

) 

■0 proc iat: :ant: :ant_close { ns } { 
variable TRACE 

if {$TRACE} { puts "iat: : ant: : close: $ns B ) 

ant_delete_all $ns 
5 ant_create_defaults 

} 

proc iat: : ant: : destroy { args } { 
0 variable TRACE 

if { $TRACE } { puts " ia t : : ant : : des troy : $args " } 

> 

5 proc iat : : ant : : set_canvas { ns args } { 
variable TRACE 

if {$ TRACE} { puts "iat: :ant: :set_ canvas: $ns $args n } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

0 

set canvas [lindex $args 0] 

} 

5 proc iat : : ant : : set_cmdcanvas { ns args } { 
variable TRACE 

if {$ TRACE) { puts ■ iat : : ant : : set_cmdcanvas : $ns $args M ) 
variable precmd 

0 

upvar #0 [join [list [namespace current] $ns cmdcanvas] ::] cmdcanvas 

set cmdcanvas [lindex $args 0] 
set precmd $ cmdcanvas 

5 

) 

proc iat: :ant : : set__image__size { ns args } { 
variable TRACE 

0 if {$ TRACE) { puts w iat: :ant: : set_image_size : $ns $args w } 

upvar #0 [join [list [namespace current] $ns imageX] ::] imageX 
upvar #0 [join [list [namespace current] $ns imageY] ::] imageY 

5 set imageX [lindex [lindex $args 0] 0] 

set imageY [lindex [lindex $args 0] 1] 

font_update $ns 

0 ) 
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proc iat : :ant: :set_image_of fset { ns args ) { 
variable TRACE 

if {$TRACE} { puts "iat; : ant : : set_image_of fset: $ns $args° } 

5 upvar #0 [join [list [namespace current] $ns offsetx] ::] offsetx 

upvar #0 [join [list [namespace current] $ns offsetY] ::] offsetY 

set offsetx [1 index [1 index $args 0] 0] 
set offsetY [lindex [lindex $args 0] 1] 

10 

) 

proc iat : : ant : : set_select_mode { ns mode } { 
variable TRACE 

15 if {$TRACE} { puts "iat; :ant: : set_select_raode : $ns $mode" > 



upvar #0 [join [list [namespace current] $ns select_mode] : : ] select _mode 



if [$mode « "edit"} { 
20 set select_jmode edit 

) else { 

set select_mode annotation 

> 



25 > 



proc iat: :ant: :ant_set_color ( ns clr } { 
variable TRACE 

if ($TRACE) { puts "iat: :ant: :ant_set_color: $ns $clr n > 

30 

variable rawsave 

variable color 

variable styleColorDef ault 



35 if {$clr 

set color $styleColorDef ault 

> else { 

set color $clr 

) 

40 

if (!$rawsave) { 

ant_save $ns 
#ant_draw $ns active 
) 

45 ) 



proc iat : : ant : : ant_set_order { ns txt ) { 
variable TRACE 

if {$TRACE) { puts a iat : : ant : : ant_set_order : $ns $txt B } 

variable rawsave 
variable order 



55 



60 ) 



set order $txt 

if {!$rawsave> { 
#ant__save $ns 
#ant_draw $ns active 

} 



proc iat : : ant : : ant — set — view ( ns txt ) { 
variable TRACE 

if {$TRACE} { puts "iat: :ant: : ant_set_view: $ns $txt w } 

variable rawsave 
variable view 



70 



75 

) 



set view $txt 

if {!$rawsave} { 
ant_save $ns 
ant_draw_all $ns 

) 



proc iat: :ant: :ant_update_view { ns ) { 
variable TRACE 

30 if ($TRACE) { puts "iat: :ant: :ant_update_view: $ns" } 
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upvar #0 [join [list [namespace current] $ns inviews] ::] inviews 
set allvals [list] 

foreach {key value) [array get inviews] { 
5 #puts 0 inview: $key = $value ,r 

set vals [split $value] 
foreach {val} $vals { 

if {[Isearch $allvals $val] <: 0} { 

set allvals [concat $allvals $val] 

10 } 
> 

} 

treturn [list ABC] 
15 return [lsort -dictionary $allvals] 
} 

proc iat : :ant: :ant_set_inview { ns txt } { 
variable TRACE 

20 if {$ TRACE) { puts "iat: :ant: :ant_set_inview: $ns $txt* } 

variable rawsave 
variable inview 

25 set inview $txt 

if (|$rawsave) { 
#ant_save $ns 
#ant_draw $ns active 

30 ) 
) 

proc iat: :ant : :ant_set__code { ns txt ) { 
variable TRACE 

35 if ($TRACE) { puts "iat: :ant: : ant_set_code : $ns $txt" } 

variable rawsave 
variable code 

40 set code $txt 

if {l$rawsave} { 
#ant_save $ns 
#ant_draw $ns active 

45 ) 
) 

proc iat : : ant : : ant_set_symbol { ns txt } { 
variable TRACE 

50 if {$ TRACE) { puts " iat : : ant : : ant_set_symbol : $ns $txt* ) 

variable rawsave 
variable symbol 

55 set symbol $txt 

if (!$rawsave) { 

#ant_save $ns 
#ant_draw $ns active 

60 ) 
) 

proc iat: rant : : ant_set_label { ns txt } { 
variable TRACE 

65 if ($TRACE) { puts "iat: :ant : :ant_set_label: $ns $txt tt ) 

variable rawsave 
variable label 

70 set label $txt 

if (l$rawsave) { 

#ant_save $ns 
#ant_draw $ns active 

75 ) 
) 

proc iati :ant : :ant_set_cs_class { ns txt ) { 
variable TRACE 

80 if {$TRACE) { puts "iat: :ant : :ant_set_cs_ class: $ns $txt" ) 
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variable rawsave 
variable cs_class 

set cs— class $txt 

5 

) 

proc iat : : ant : : ant_set_cs_tumor { ns txt > { 
variable TRACE 

L0 if {$TRACE> { puts ■ iat : : ant : : ant_set_cs_tumor : $ns $txt n > 

variable rawsave 
variable cs_ tumor 

L5 set cs_tumor $txt 

) 

proc iat : : ant : : ant_set_cs_node { ns txt } { 
10 variable TRACE 

if {$TRACE} { puts " iat : : ant : : ant_set__cs_node : $ns $txt" ) 

variable rawsave 
variable cs_node 

set cs_node $txt 

} 

10 proc iat: :ant: :ant__set_cs_metastasis { ns txt } { 
variable TRACE 

if {$TRACE} { puts "iat: :ant: :ant_set_cs_metastasis: $ns $txt" > 

variable rawsave 
15 variable cs_metastasis 

set cs_metastasis $txt 

} 

0 

proc iat :: ant :: an t_set_cs_.no te { ns txt } { 
variable TRACE 

if {$TRACE} { puts "iat: :ant: :ant_set__cs_note: $ns $txt° > 

5 variable rawsave 
variable cs_jnote 

set cs_note $txt 

0 } 

proc iat : : ant : : ant_set_caption { ns txt } { 
variable TRACE 

if { $TRACE} { puts "iat: :ant: :ant_set_caption: $ns $txt" > 

5 

variable rawsave 
variable caption 

set caption $txt 

0 

if {l$rawsave> { 
#ant_save $ns 
#ant_draw $ns active 

) 

5 } 

# must be called as part of imageUpdate 
proc iat: :ant: :font_update { ns } { 

variable styleFontName 
0 variable styleFont Small 

variable stylePontDe fault 

variable stylePontLarge 

upvar #0 [join {list [namespace current] $ns imageX] ::] imageX 
5 upvar #0 [join [list [namespace current] $ns imageY] ::] imageY 

set flist [list] 

lappend flist styleFontSmall fontSmall 
lappend flist styleFontDefault fontDefault 
0 lappend flist styleFontLarge fontLarge 

foreach {size font} $ flist { 
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#upvar #0 styleSize $size 

set calcSize [expr round (ceil (( ($imageX + $imageY)/2) * 0.001 * [set $size] ) ) ] 
font configure $font -family $styleFontName -size $calcSize 

> 

5 } 

proc iat : : ant : : ant_next_key { } { 
variable rawkey 
set key $rawkey 
.0 incr rawkey 

return $key 

> 

proc iat : : ant : : orderChange {old new) { 
5 variable kind 
variable order 
variable orders 
variable orderToKey 

0 if {[info exists orderToKey ($old) J } { 

set orderToKey ($new) $orderToKey ($old) 
unset orderToKey ( $old) 
set order $new 

set orders ($orderToKey($new) ) $new 
5 > else { 

# someting is wrong... orderToKey is not in sync with annotations... 
error "orderToKey does not contain $old" 

) 

# if current annotation is a group then change sub-annotations orders 
0 # that match the old order pattern. . . 

if {$kind == "group"} { 

foreach {key ord} [array get orders] { 
if {[regexp « A $old» $ord] } { 
set tmpord 

5 regsub BA $old" $ord $new tmpord 

#puts "iat: : ant; -.orderChange group $ord -> $tmpord" 
set orders ($key) $tmpord 

} 

) 

0 > 
) 

proc iat : : ant : : orderToKey { ord } { 
variable orders 
5 variable orderToKey 

set key * ■ 

if {[info exists orderToKey ($ord) 3 > {. 
set key $orderToKey ($ord) 

0 } 

return $key 

> 

5 proc iat: :ant: :imageUpdate { ox oy ix iy } { 

variable canvas 

variable offsetX 

variable offsetY 

variable imageX 
0 variable imageY 

variable polygons 

variable points 

# breaking api and not loading /saving annotation... 

5 

set offsetX $ox 
set offsetY $oy 
set imageX $ix 
set imageY $iy 

0 

# pointer needs this into too . . . 
iat: : pointer: ; imageUpdate 

styleFontupdate 

5 ) 

proc iat: :ant: :isPointInPoints { pt pts } { 
set n 0 

set x [lindex $pt 0) 
0 set y [lindex $pt 1] 

foreach pt $pts { 
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set vx £1 index $pt 0) 
set vy [lindex $pt 1J 
if {[expr abs($vx - $x>] < 4) { 

if {[expr abs($vy - $y) ] < 4} { 
return $n 

) 

} 

incr n 



> 

10 return 



proc iat: :ant : : isPointlnBox { x y box } { 
set xl [ lindex $box 0] 
15 set yl r lindex $box 1] 
set x2 [lindex $box 2] 
set y2 [lindex $box 31 
if {[expr $x > $xl && $x < $x2J) { 

if {[expr $y > $yl && $y < $y2] } { 
20 return 1 

} 

) 

return 0 

} 

25 

proc iat: :ant: :pointsTranslateOLD { dx dy pts ) { 

#puts °iat: :ant: : point s_trans late: $dx $dy" 
#puts ■ points = $pts" 
set newpts [list] 
30 foreach pt $pts { 

set x [expr [lindex $pt 0] + $dx] 
set y [expr [lindex $pt 1] + $dy] 
lappend newpts [list $x $y] 

) 

35 return $newpts 



proc iat: :ant: : point sFroml0K_OLD { maxX maxY pts } { 
#puts °iat: :ant: spointsFromlOK: $pts M 
40 set newpts [list] 
foreach pt $pts { 

set x [expr round (( [lindex $pt 0] *$maxX) /10000) +1] 
set y [expr round( ( [lindex $pt 1] *$maxY) /10000) +1] 
# also add offset! 
35 #set x [expr $x + $offsetX] 

#set y [expr $y + $offsetY] 
lappend newpts [list $x $y] 

) 

return $newpts 

50 ) 

proc iat: :ant: :pointsTol0K^OLD { maxX maxY pts } { 
#puts "iat :: ant :: point sTol OK: $maxX $maxY $pts" 
set newpts [list] 
55 foreach pt $pts { 

set x [expr round (( [lindex $pt 0] *10000) /$maxX> ) 
set y [expr round (( [lindex $pt 1] *10000) /$maxY) ] 
lappend newpts [list $x $y] 

) 

50 #puts "before: $pts" 

#puts "after: $newpts" 

return $newpts . 



55 proc iat: :ant: :pointsTol0K { maxX maxY pts ) { 

#puts n iat: :ant: :pointsTol0K; $maxX $maxY $pts° 
set newpts [list] 
foreach pt $pts { 

set x [format n %1.5f [expr double ( [lindex $pt 0])/$maxX]] 
70 set y [format -%1.5f" [expr double ([ lindex $pt 1] ) /$maxY] ] 

lappend newpts (list $x $y] 

) 

#puts "before: $pts" 
#puts "after: $newpts D 
75 return $newpts 



proc iat: :ant: :pointsFromlOK { maxX maxY pts } { 
#puts "iat: : ant: : point sFromlOK: $pts" 
50 set newpts [list] 
foreach pt $pts { 



WO 2004/057439 - 25 - PCT/US2003/017138 

Appendix 1 

set x [expr round < [lindex $pt 0)*$maxX)) 
set y texpr round{ [lindex $pt U*$maxV)] 
lappend newpts [list $x $y) 

} 

5 #puts "before: $pts° 

#puts "after: $newpts" 
return $newpts 

> 

10 # calculate "centroid" of one, two and three+ point rois 
proc iat : : ant : : roiCentroid { } { 
#puts "polygonCentroid" 
variable points 
set ttlpts [llength $pointsJ 
15 set xs Hist) 
set ys [list) 
f oreach pt $points { 

lappend xs [lindex $pt 0) 
lappend ys [lindex $pt 1) 

20 ) 

if {$ttlpts <= 0} { 

return 0 
) elseif {$ttlpts « 1) { 

return [list [lindex $xs 0) [lindex $ys 0)) 
25 ) elseif {$ttlpts == 2} { 

set midx [expr ([lindex $xs 0]+[lindex $xs l))/2] 
set roidy [expr ([lindex $ys 0) + [lindex $ys l))/2) 
return [list $midx $midy) 

) 

30 frputs "xs » $xs B 
#puts "ys s= $ys" 
set n [llength $xs) 
if {$n < 3) { return 3 } 

set ai 0 ; set atmp 0 ; set xtmp 0 ; set ytmp 0 
35 set j 0 

for {set i [expr $n -1)} {$j < $n) {incr j> { 

set ai [expr [lindex $xs $i] * [lindex $ys $j) - [lindex $xs $j) * [lindex $ys $i) 1 

incr atmp $ai 

incr xtmp [expr ([lindex $xs $j) + [lindex $xs $i) ) * $ai) 
40 incr ytmp [expr ([lindex $ys $j] + [lindex $ys $i] ) * $ai] 

set i $j 

> 

set area [expr $atmp / 2] 
if {$atmp != 0} { 
45 set xc [expr $xtmp / (3 * $atmp) ) 

set yc [expr $ytmp / (3 * $atrop) ] 

return [list $xc $yc) 

> 

return 2 

50 } 

proc iat: :ant: :ant_create_defaults {) { 

#puts " iat : : ant : : an t_creat e_de faults n 

55 variable antkey 
variable order 

variable points 

variable heads 

variable verts 
60 variable tails 
variable dSYMs 
variable dPTRs 

variable kind 
variable color 
65 variable inview 
variable code 

variable symbol 
variable label 
variable caption 
70 variable cs_class 
variable cs_tumor 
variable cs_node 
variable cs_metastasis 
variable cs^note 

75 

variable styleColorDe fault 

set antkey fl " 
set order "0° 
80 set points [list] 

array unset heads 
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array set heads [list] 

array unset verts 

array set verts [list] 

array unset tails 
5 array set tails [list] 
array unset dSYMs 
array set dSYMs [list] 
array unset dFTRs 
array set dPTRs [list] 

10 

set kind "none" 

set color $styleColorDefault 

set inview " " 

set code " * 
15 set symbol 

set label ■ ■ 

set caption 

set cs_class * ■ 

set cs_tumor tt * 
20 set cs_node 

set cs_j«ieta stasis no 

set cs_jtiote " ■ 

return 

25 } 

proc iat : ; ant : : ant_create { ns {inkind (none)} } { 
variable TRACE 

if ($TRACE) { puts "iati sant: :ant_create: $ns $inkind n > 

30 

upvar #0 [join [list [namespace current] $ns orders] ::] orders 

variable antkey 
variable order 
35 variable kind 

ant_create__def aults 

# find max existing order. . . 
40 set max 0 

for each {key value) [array get orders] { 
if { [expr ceil ($value) ] > $max) { 

set max [expr int{ceil($value) ) ] 

) 

45 } 

incr max 

set antkey [ant_next_key] 
set order $max 
50 set kind $inkind 

) 

proc iat : : ant : : ant_create_po inter { ns head tailpt {vertpts {}) } { 
55 variable TRACE 

if { $TRACE } { puts »iat: :ant: :ant_create_pointer : $ns $head $ tailpt $vertpts" } 

variable rawsave 
variable autoptr 
50 variable thisptr 

variable antkey 

variable points 

variable heads 

variable verts 
55 variable tails 
variable dSYMs 
variable dPTRs 

set idx $head 
70 if {$rawsave} { 

if {$idx ■« "auto") { 

# this assumes roi has < 1000 pts 
set idx [incr autoptr) 

) 

75 } else { 

if {$idx ==s "auto") { 

set idx [nearest_point $ tailpt $points] 

) 

) 

30 

#puts » idx = $idx° 
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set thisptr $idx 

set heads ($idx) $head 

set verts ($idx) $vertpts 
set tails ($idx) $tailpt 
5 set dS?Ms($icbc) "none 0 
set dPTRs($idx) ° arrow" 

if {t$rawsave) { ant_save $ns } 

} 

L0 

proc iat: :ant: :ant_ptr_symbol { ns ptnum {style "none"} } { 
variable TRACE 

if {$ TRACE) { puts ■ iat : : ant : : ant_ptr_symbol : $ns $ptnum $ style* } 

15 variable rawsave 
variable thisptr 
variable dSYMs 

if ($ptnum == "active" } { set ptnum $thisptr } 
20 #puts 0 ptnum = $ptnum° 
if {$style » ■ toggle" } { 
set old $dSYMs ( $ptnum) 
switch $old { 

"none" { set style "symbol" ) 
25 "symbol" { set style "label" } 

"label" { set style "code" } 
"code" { set style "none" > 
default { set style "symbol" > 

} 

30 set dSYMs { $ptnum) $style 

} else < 

set dSYMs ( $ptnum) $style 

) 

35 if {!$rawsave} { ant_save $ns > 
) 

proc iat: rant : :ant_ptr_style { ns ptnum {style "arrow") ) { 
variable TRACE 

40 if {$TRACE) { puts "iat :: ant : :ant_po interns tyle: $ns $ptnum $style" ) 

variable rawsave 
variable thisptr 
variable dPTRs 

J5 

if {$ptnum == "active") { set ptnum $thisptr ) 
#puts " ptnum = $ptnum" 
if {$style == "toggle") { 
set old $dPTRs($ptnum) 
50 switch $old { 

"none" { set style "line" ) 
"line" { set style "arrow" ) 
"arrow" ( set style "diamond" ) 
•diamond" { set style "none" ) 

55 ) 

set dPTRs($ptnum) $style 
) else { 

set dPTRs ( $ptnum) $style 

) 

50 

if { ! $rawsave) { ant_save $ns ) 

) 

proc iat : : ant : : ant_ptr_pin { ns ptnum {pin "auto") ) { 
55 variable TRACE 

if {$TRACE) { puts "iat: : ants : ant_pointer_s tyle: $ns $ptnum $pin" ) 

variable rawsave 
variable heads 

70 

#puts " ptnum = $ptnum" 
if {$pin bo -toggle") { 

set old $heads ( $ptnum) 
switch $old { 
75 "auto" { set pin $ptnum t ) 

default { set pin "auto" ) 

) 

set heads ( $ptnum) $pin 
) else { 

30 set heads ($ptnum) $pin 

) 
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if {l$rawsave} { ant_save $ns > 

) 

5 proc iat : : ant : : ant_delete { na key } { 
variable TRACK 

if {$TRACE) { puts "iat: : ants :ant_delete: $ns $key" ) 



variable antkey 

.0 

upvar #0 [join [list [namespace current] $ns polys] ::] polys 
upvar #0 (join [list [namespace current] $ns kinds] ::] kinds 
upvar #0 [join [list [namespace current] $ns aheads] ::] aheads 
upvar #0 [join [list [namespace current] $ns averts] ::] averts 
.5 upvar #0 [join [list [namespace current] $ns atails] ::] atails 

upvar #0 [join [list [namespace current] $ns colors] ::] colors 
upvar #0 [join [list [namespace current] $ns inviews] ::] inviews 
upvar #0 [join [list [namespace current] $ns symbols] ::] symbols 
upvar #0 [join [list [namespace current] $ns labels] ::] labels 

>0 

if {$key == "") { set key $antkey } 
if {$key == "active" > { set key $antkey > 
#puts ■ DELETING ANT: $key" 



>5 if {[info exists polys ($key) ] } { 

set polys ($key) [array get [list]] 
set kinds ($key) [array get [list]] 
set aheads ($key) [array get [list]] 
set averts ($key) [array get [list]] 

10 set atails ($key) [array get [list]] 

set colors ($key) [array get [list]] 
set inviews ($key) [array get [list]] 
set symbols ($key) [array get [list]] 

set labels ($key) [array get [list]] 

35 

unset polys ($key) 
unset kinds ($key) 
unset aheads ($key) 
unset averts ($key) 
10 unset atails ($key) 

unset colors ($key) 
unset inviews ($key) 
unset symbols ($key) 
unset labels ($key) 

15 } 



ant_create_defaults 



> 

SO 

proc iat: :ant: :ant_delete_all { ns > { 
variable TRACE 

if ($TRACE) { puts "iat: :ant: :ant_delete_all: $ns" } 
55 variable rawkey 

upvar #0 [join [list [namespace current] $ns polys] ::] polys 



foreach [key value) [array get polys] { 
50 puts a key = $key, value = $value n 

ant_delete $ns $key 

} 

set rawkey 1 



55 > 



proc iat: :ant: :roiDelete { {key {}} } ( 

#puts ■ roi : : roiDelete : $key " 

variable canvas 
70 variable polygons 

variable roiKey 

variable points 

variable sectors 

variable point 
75 variable select 



variable orders 
variable symbols 
variable labels 
30 variable captions 
variable centers 
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#variable gravity s 
variable pointers 
variable sizes 
#variable lengths 
5 variable colors 
#variable views 

variable order 

variable symbol 
10 variable label 

variable caption 

variable center 

#variable gravity 

variable pointer 
15 variable size 

#variable length 

variable color 

#variable view ( 

20 variable orderToKey 

if {$key B M { set key $roiKey } 

if {[info exists polygons {$ key) ] ) { 
25 roiLoad $key 

unset polygons ($roiKey) 

unset orders ($roiKey) 

unset symbols ($roiKey) 

unset labels ($roiKey) 
30 unset captions ($roiKey) 

unset centers ($roiKey) 

#unset gravitys($roiKey) 

unset pointers { $roiKey) 

unset sizes ($roiKey) 
35 #unset lengths ($roiKey) 

unset colors ($roiKey) 

#unset views ($roiKey) 

> 

if {[info exists orderToKey ($ order )] } { 
40 unset orderToKey ($ order) 

> 

set roiKey " n 

set points [list] 
45 set order " ' 

set symbol 

set label " M 

set caption " ■ 

set center * " 
50 #set gravity 

set pointer " " 

set size ■ ■ 

#set length aft 

set color ■■ 
55 #set view "* 

set select READY 

> 

50 proc iat: : ant: -.roiDeleteAll {) { 

#puts ■ roi : : roiDeleteAll " 

variable rawXD 

variable roiKey 

variable orders 
55 variable select 

roiEraseAll 

set keys [lsort -dictionary [array names orders] 3 
70 foreach key $keys { 
roiDelete $key 

> 

set rawID 1000 

75 set select READY 
> 

proc iat z : ant: : autoload { ns key } { 
variable TRACE 

30 if ($TRACE) { puts »iat: :ant: :ant_load: $ns $key" > 



10 



15 



20 



25 



30 



35 



40 



45 



50 
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variable antkey 
variable order 

variable points 

variable heads 

variable verts 
variable tails 
variable dSYMs 
variable dPTRs 

variable kind 
variable color 
variable inview 
variable code 

variable symbol 
variable label 
variable caption 
variable cs_class 
variable cs_tumor 
variable cs_node 
variable cs_metastasis 
variable csjiote 

upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list (namespace current] 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join (list [namespace current] 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list (namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list [namespace current] $ns 
upvar #0 [join [list (namespace current] $ns 

if {$key == "default" > { 
ant_create_defaults 
return 

) 

if {$key == 
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$ns offsetX] ::] offsetX 

$ns offsetY] ::] offsetY 

$ns imageX] : : ] imageX 

$ns imageY] : : ) imageY 

orders] ::] orders 

polys] : : ] polys 

$ns aheads] : ; ] aheads 

$ns averts ] : : ] averts 

$ns atails] : :] atails 

adSYMs] ::] adSYMs 

adPTRs ] : : ] adPTRs 

kinds] : : ] kinds 

$ns colors] ::] colors 

inviews] ;:] inviews 

codes] : : ] codes 

symbols] ::] symbols 

$ns labels] ::) labels 

captions] ::] captions 

cs_classs] ::] cs_classs 

cs__tumors] : ; ] cs_tumors 

cs_nodes] ::] cs_nodes 

cs_metastasiss] ::] cs_metastasiss 

csjnotes] : : ] cs_jiotes 



' } { return ) 



55 



set antkey $key 

set tmps $polys($antkey) 

set tmps [pointsFromlOK $ imageX $ imageY $tmps] 

set tmps [points_translate $offsetX $offsetY $tmps] 

set points $tmps 

#puts ■ points ($antkey) =» $points tt 



60 



65 



70 



75 



#puts ■ before heads = (array get heads] ■ 

array unset heads 

array set heads $aheads ( $antkey ) 

#puts 0 heads ($antkey ) = [array get heads] 

set tmps [list] 

foreach {key value) $atails ($antkey) { 

set pts [pointsFromlOK $imageX $imageY [list $value] ] 
set pts [points_translate $offsetX $offsetY $pts] 
lappend tmps $key [lindex $pts 0] 

) 

#puts " before tails = [array get tails] " 
array unset tails 
array set tails $tmps 

#puts * tails ($antkey) = (array get tails]" 

array unset dSYMs 

array set dSYMs $adSYMs ( $antkey ) 



30 



array unset dPTRs 

array set dPTRs $adPTRs <$antkey) 
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set txnps [list] 

foreach {key value} $averts ($antkey) { 

set pts [pointsFromlOK $imageX $imageY $value] 
set pts [points_translate $offsetX $offsetY $pts] 
5 lappend tmps $key $pts 

> 

#puts " before verts = [array get verts] ■ 
array unset verts 
array set verts $tmps 
10 #puts " verts ($antkey) * [array get verts]" 

set order $orders ($antkey) 

set kind $kinds ($antkey) 
set color $colors ( $antkey ) 
15 set inview $inviews ($antkey) 
set code • $codes ( $antkey ) 

set symbol $ symbol s ($antkey) 
set label $ labels ($antkey) 
set caption $captions ($antkey) 

20 

set cs_class $cs_classs ($antkey) 
set cs_tumor $cs_tumors ($antkey) 
set cs — node $cs_nodes ($antkey) 
set cs__metastasis $csjnetastasiss{$antkey) 
25 set cs_note $cs_notes ($antkey) 

return 



30 #puts "roiLoad" 

variable canvas 

variable polygons 

variable roiKey 

variable imageX 
35 variable imageY 

variable of fsetx 

variable offsetY 

variable points 

variable pointsDirty 
40 variable symbolDirty 

variable point 

variable select 

variable orders 
45 variable kinds 

variable symbols 

variable labels 

variable captions 

variable centers 
50 variable pointers 

variable sizes 

variable colors 

variable views 

variable sorls 
55 variable pointer Points 

variable symbolPoints 

variable order 

variable kind 
60 variable symbol 

variable label 

variable caption 

variable center 

variable pointer 
65 variable size 

variable color 

variable view 

variable sorl 

variable pointerPoint 
70 variable symbolPoint 

variable angle 

if {$key == nn ) { return > 

75 set roiKey $key 

set points $polygons ($roiKey) 

set points [point sFroml OK $iroageX SimageY $points] 

set points [point s_trans late $offsetX $offsetY $pointsJ 

80 tfputs "pre load lblpt = $ symbolPoint s ($roiKey) " 
set symbolPoint $ symbolPoint s ($roiKey) 
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set syribolPoint [point sFroml OK $imageX $imageY [list $symbolPoint] ) 

set symbolPoint [lindex [points_translate $offsetX $offsetY $symbolPoint) 0) 

#puts "post load lblpt = $symbolPoint B 

5 set order $orders($roiKey) 

set kind $kinds ($roiKey) 

set symbol $symbols($roiKey) 

set label $ labels ($roiKey) 

set caption $captions {$roiKey) 
10 set center $centers($roiKey) 

set pointer $po inter s ($roiKey) 

set size $sizes($roiKey) 

set color $colors($roiKey) 

set view $views ($roiKey) 
15 set sorl $sorls {$roiKey) 

#set pointerPoint $pointer Point s ($roiKey) 

set pointsDirty 0 
set symbolDirty 0 

20 

roiPreDrawCalc 

#puts "order = $order" 
#puts "symbol = $symbol B 
25 #puts "label = $label" 

#puts "caption = $caption" 
#puts "center = $center" 
#puts "gravity = $gravity tt 
#puts "pointer = $pointer" 

30 } 

proc iat: tantt :ant_save { ns ) { 
variable TRACE 

if {$TRACE> { puts "iat: :ant: :ant_save: $ns» } 

35 

variable rawsave 

variable antkey 

variable order 

variable points 
40 variable heads 

variable verts 

variable tails 

variable dSYMs 

variable dPTRs 
45 variable kind 

variable color 

variable inview 

variable code 

variable symbol 
50 variable label 

variable caption 

variable cs_class 

variable cs_tumor 

variable cs^node 
55 variable cs_metastasis 

variable cs_note 

variable view 

if {$antkey ==««}< return } 
60 if {$points =={}}{ 

ant_ create_defaults 
return 

> 

65 upvar #0 [join [list [namespace current] $ns of f setX) : : ] of f setX 

upvar #0 [join [list [namespace current] $ns offsetY] ::] offsetY 
upvar #0 [join [list [namespace current] $ns imageX] ::] imageX 
upvar #0 [join [list [namespace current] $ns imageY] ;:] imageY 
upvar #0 [join [list [namespace current) $ns orders] ::] orders 
70 upvar #0 [join [list [namespace current) $ns polys] ::] polys 

upvar #0 [join [list [namespace current] $ns aheads] ::] aheads 
upvar #0 [join [list [namespace current] $ns averts] ::] averts 
upvar #0 [join [list [namespace current] $ns atails] ::] atails 
upvar #0 [join [list [namespace current] $ns adSYMs] : : ] adSYMs 
75 upvar #0 [join [list [namespace current) $ns adPTRs) ::] adPTRs 
upvar #0 [join [list [namespace current) $ns kinds] ::] kinds 

upvar #0 [join [list [namespace current] $ns colors] ::] colors 
upvar #0 [join [list [namespace current] $ns inviews) ::] inviews 
upvar #0 [join [list [namespace current] $ns codes] ::] codes 
80 upvar #0 [join [list [namespace current] $ns symbols] ::) symbols 

upvar #0 [join [list [namespace current] $ns labels] ::] labels 
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upvar #0 [join llist [namespace current] $ns captions] ::] captions 

upvar #0 [join [list [namespace current] $ns cs_ clasBS] :;] cs_ciasss 

upvar #0 [join (list [namespace current] $ns cs_ tumors) ::] cs_tumors 

upvar #0 [join [list [namespace current] $ns cs_nodes) ::] cs_nodes 

5 upvar #0 [join [list [namespace current] $ns cs_metastasiss] ;:] cs_jnetastasiss 

upvar #0 [join [list [namespace current] $ns cs_notes] : : ] cs_notes 

#if {$rawsave> { puts ■ RAW SAVE!" > 

.0 if {$rawsave} { 
} else { 

if { $ inview == &&$view != "ALL" && $view != "NONE- ] { 
set inview $view 

> elseif { $ inview ==■"&& $view == "ALL" > { 
.5 set inview "NEW" 

) elseif { $ inview ==""&& $view == "NONE" ) { 
set inview "NEW" 

) 

) 

\0 

if {$rawsave> { 

set tmps $points 

> else { 

set tmps $points 

!5 set tmps [point s_trans late -$offsetX -$offsetY $tmps] 

set tmps [point sTol OK $imageX $ image Y $ traps) 

) 

set polys ($antkey) $tmps 

#puts " points <$antkey) = $polys{$antkey) ■ 

\0 

# pointer heads 

set aheads($antkey) [array get heads] 
set adSYMs<$antkey) [array get dSYMs) 
set adPTRs($antkey) [array get dPTRs] 
J 5 #puts ■ aheads($antkey) = $aheads ($antkey) " 

# pointer tails 
set tmps [list] 

foreach {key value) [array get tails] { 
10 if {$rawsave) { 

set pts [list $value] 
) else { 

set pts [points_translate -$of f setX -$of fsetY [list $value] ) 
set pts [pointsTolOK $imageX $imageY $pts] 

15 ) 

lappend tmps $key [1 index $pts 0] 

) 

set atails($antkey) $tmps 

#puts " atails($antkey) - $atails ($antkey) ■ 

SO 

# pointer verticies 
set tmps [list] 

foreach {key value} [array get verts] { 
if {$rawsave} { 
>5 set pts $value 

) else { 

set pts [points_translate -$offsetX -$offsetY $value) 
set pts [pointsTolOK $imageX $imageY $pts] 

) 

50 lappend tmps $key $pts 

) 

set averts ($antkey) $tmps 

#puts ■ averts ($antkey) = $averts ( $antkey) ■ 

55 set orders ($antkey) $order 

set kinds <$antkey) $kind 
set colors ($antkey) $color 
set inviews ($antkey) $ inview 
set codes ( $antkey) $code 
70 set symbols ($antkey) $symbol 
set labels ($antkey) $label 
set captions ($antkey> $caption 

set cs_classs ($antkey) $cs_class 
75 set cs_tumors ( $antkey ) $cs_ tumor 
set cs_nodes ($antkey) $cs_node 
set cs_metastasiss ($antkey) $cs_metastasis 
set cs_notes ($antkey) $cs_note 



30 # This must be done carefully. . . 

# calculate dynamic data for annotation. Currently: heads 
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# raw data must not be left in loaded data... 
if {$rawsave> { 
set rawsave 0 

ant_load $ns $antkey 

for each {key value} E array get heads] { 
if {$value == ""} { continue } 
if {$value == "auto-} { 

set idx tnearest_point $tails($key) $points] 
if {$idx != $key} { 

# update head and tail 

#puts ■ RAWSAVE PTR UPDATE: $key -> $idx" 

set heads ($idx) auto 

set verts ($idx) $verts($key) 

set tails {$idx> $tails($key) 

set dSYMs($idx) $dSYMs($key) 

set dPTRs($idx) $dPTRs($key) 

set heads ($key) 

set verts ($key) "" 

set tails ($key) 

set dSYMs($key) " " 

set dPTRs($key) 

) 

) 



ant_save $ns 
ant_create_defaults 
JO set rawsave 1 

} 

return 

35 #puts -order = $ orders ($roiKey) ■ 

#puts "symbol = $ symbols ($roiKey) " 
#puts "label = $ labels ($roiKey) - 
#puts "caption = $captions ($roiKey) • 
#puts "length = $lengths ($roiKey) " 

40 #puts "size - $sizes ($roiKey) n 

#puts "color = $colors ($roiKey) " 
#puts "pointer = $pointers ($roiKey) " 
#puts "gravity = $gravitys ($roiKey) ■ 
#puts "center = $centers ($roiKey) " 

45 

> 

proc iat : : ant : : ant_kind { ns } { 
variable TRACE 
50 if ($TRACE) { puts "iat: rant r rant Jcxndr 5ns J 

variable kind 

return $kind 



55 ) 



60 



proc iat: :ant: :ant_point { ns idx } { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :ant_point: $ns $xdx J 
variable points 
return [lindex $points $idx] 



) 

proc iat: rant: :ant_points { ns > { 
variable TRACE 

if {$ TRACE) { puts "iat: rant: :ant_points: $ns ) 
70 variable points 

return $points 



) 

75 



proc iat : : ant : : roiMoveRelative { dpt } { 
variable canvas 
variable points 



80 set dx [lindex $dpt 0] 
set dy [lindex $dpt 1] 
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set points tpointsTranslate $dx $dy $points] 
return 0 

} 

5 

proc iat: J ant: :roiCopy {> ( 
#puts "roiCopy" 
variable canvas 
variable points 

10 

set newpts $points 

roiCreate 

set points $newpts 

15 return 0 
> 

proc iat: .-ant: :ant_erase { ns key ) { 
variable TRACE 

20 if {$ TRACE} { puts ■ iat : : ant : : ant_erase : $ns $key" } 

variable antkey 

upvar #0 (join [list [namespace current] $ns canvas] ::] canvas 

25 

set key [string tolower $key] 

if {$key == ■ " } { set key $antkey ) 

if {$key == "active" > { set key $antkey ) 

30 $canvas delete handle 

$canvas delete segment 
$ canvas delete ptrvert 
$canvas delete ptrsect 

35 $canvas delete key$key 

> 

proc iat: :ant: :ant_erase_all { ns } { 
40 variable TRACE 

if {$TRACE> { puts "iat: :ant: :ant_erase_all : $ns" } 

upvar #0 [join [list [namespace current] $ns polys] ::] polys 

45 foreach {key value) [array get 'polys] { 

ant_erase $ns $key 

} 

) 

50 

proc iat: :ant: :ant_dravuprecalc { ns } { 

#puts ■ iat : : ant : : ant_draw_precalc : $ns " 

variable points 
55 variable kind 

variable color 

#variable center 

invariable pointer 

#variable angle 
60 #variable pointerPoint 

#variable symbolPoint 

variable fillcolor 
variable linecolor 
65 variable styleColor Light 

variable styleColorDefault 
variable styleColorDark 
variable symbolFont 

70 if {$color "default" > { 

set fillcolor $ styleColorDefault 
set linecolor $ styleColorDefault 

} else { 

switch $color { 

75 "light" { set fillcolor $styleColorLight ; set linecolor $styleColorDark ) 

"dark" { set fillcolor $styleColorDark ; set linecolor $styleColorLight } 
default { 

set fillcolor $color 
set linecolor $color 

30 } 



WO 2004/057439 



- .5b - 
Appendix 2 



} 

) 

# group doesn't have visual annotation piece 
5 if {$kind == "group") { return } 

#set angle [x2pts_angle $pointerPoint $ symbolPoint) 

set size default 
10 set symbolFont fontDefault 
switch $size { 

"small" { set symbolFont fontSmall } 

"default" { set symbolFont fontDefault > 

■large" { set symbolFont fontLarge } 

15 } 
return 

# This is one case where symbolPoint is not user specified (also default) 
20 if {"$center$po inter" == "centernone" } { 

set symbolPoint [roiCentroid] 

> 

# draw from center or gravitate to edge . . . 
25 if {$center == "center"} { 

set pt CroiCentroidJ 

# This needs to be really repaired. . . one and two point rois 

# dont have a center, so choose the first point... I 
if {$pt == 3} { set pt [lindex $points 0] } 

30 ) else { 

#set tmp [iat: -.pointer: :gravityPoint $gravity [join $points] ) 
set tmp Ciat: j pointer : tnearestPoint $ symbol Point $points] 
set pt [lindex $points $tmp] 

) 

35 #puts "pointer index: $tmp" 

set pointer Point $pt 

set angle [iat :: pointer : :2ptsAngle $pointerPoint $symbolPoint] 
#set angle [iat: : pointer : :gravityAngle $gravity] 

> 

40 

proc iat : : ant : : ant_draw { ns key } { 
variable TRACE 

if {$TRACE> { puts "iat: :ant: :ant_draw: $ns $key" 

15 upvar #0 [join [list [namespace current) $ns polys) ::) polys 

variable view 
variable inview 

50 variable ant key 

variable points 
variable kind 

#variable order 

variable color 
55 variable fillcolor 

variable linecolor 

#variable view 

#variable pointerPoint 

50 upvar #0 [join [list [namespace current) $ns canvas] ::) canvas 

upvar #0 [join [list [namespace current) $ns offsetX) ::] offsetX 
upvar #0 [join [list [namespace current] $ns offsetY) ::) offsetY 

set order "orderX" 

>5 

set key [string tolower $key] 

if {$key == ""} { set key $antkey ) 
if {$key == "active") { set key $antkey } 
if {$key un } { return 0 } 

?0 

# Must do this every draw in case of scale. . . 
ant_erase $ns $key 

ant_load $ns $key 

75 # return based on view 
if {$view == "ALL" } { 

# do nothing. . . 
} else { 

if {$view == "NONE" } { return 0 } 
*0 if {[lsearch [split $inview] $view) < 0) { return 0 ) 

) 
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ant_draw_precalc $ns 

if {$kind =- "none") { return 2 } 
5 if {$kind == "group"} { return 0 } 

#puts " antkey = $antkey" 
#puts " kind = $kind" 

10 set parts "all" 
switch $parts { 
-none" {} 
"region" {} 

# all or pointer 
15 default { 

ant_draw_pointers $ns 

) 

) 

20 switch $parts { 
"none" { } 
"pointer" {} 

# all or region 
default { 

25 set tmps [join $points] 

switch $kind { 
{ 

$canvas create line $tmps -smooth true -width 2 -fill $fillcolor -tags [list ant roi 
key$antkey $order] 
30 > 
"area" { 

$canvas create poly $trops -smooth true -outline $fillcolor -width 2 -fill "" -tags [list 
ant roi key$antkey $ order 3 

#$canvas create poly $tmps -outline black -width 2 -fill -tags [list ant roi 

35 key$antkey $order] 
> 

# point is default! 
default { 

foreach {x y} $tmps { 

10 $canvas create oval [expr $x-6] [expr $y-6] [expr $x+6] [expr $y+6] -outline 

$fillcolor -width 3 -fill "" -tags [list ant roi key$antkey $order] 
> 

} 

} 

as > 
> 

$ canvas raise head 

30 return 0 
> 

proc iat : :ant: :ant_draw_all { ns ) { 
variable TRACE 
55 if { $TRACB } < puts "iat: :ant: :ant_draw_all : $ns" > 

upvar #0 (join [list [namespace current] $ns polys] ::) polys 

foreach {key value) [array get polys J { 
50 ant_draw $ns $key 

} 

} 

55 proc iat: : ant: : ant_draw__po inters { ns {style normal}} { 
variable TRACE 

if { $ TRACE } { puts n iat :: ant: :ant_draw_po inters: $ns" } 



70 



variable heads 



set rv -1 
set go 1 

while {$go >= 0} { 
set go -1 

? 5 foreach {key value) [array get heads] { 

if {$value == ""} { continue } 
set go [ant_draw_pointer $ns $key $ style] 
if {$go >= 0} { set rv $go; break } 
if {$style == "edit") { 

JO ant_draw_ptr_vertexs $ns $key 

ant_draw_ptr_sectors $ns $key 
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> 

} 

) 



5 return $rv 

) 

proc iat: : ant: : an t_draw_po inter SAVE { ns ptnum {style normal}} { 
#puts " iat : : ant : : ant_draw_pointer ; $ns $ptnum n 

.0 

variable antkey 
variable points 
variable heads 
variable verts 
.5 variable tails 

variable color 
variable fillcolor 
variable linecolor 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

puts ■ heads ($ptnum) = $heads ($ptnum) ■ 

puts ■ tails ($ptnum) = $ tails ($ptnum) " 

15 

set value $ heads ($ptnum) 

if {$value 0 ■ } { return } 

if {$value == "auto") { 

set idx [nearest_point $taiis ($ptnum) $points] 
i0 if {$idx 1= $ptnum> { 

# update head and tail 
set heads ($idx) auto 
set verts ($idx) $verts ($ptnum) 
set tails ($idx) $tails{$ptnum) 
;5 set heads ($ptnum) 

set verts ( $ptnum) " * 
set tails ($ptnum) 
. set ptnum $idx 
return $idx 

0 } 
> 

set headpt [lindex $points $ptnum] 

set tailpt $tails ($ptnum) 

if {$tailpt { return } 

5 

puts 0 head = $headpt" 

puts " verts = $verts($ptnum) " 

puts ■ tail = $ tailpt" 

0 set ptrlen [lindex [x2pts_length $headpt $tailptj 0] 
set angle [x2pts_angle $headpt $ tailpt] 



set x [lindex $headpt 0] 
5 set y [lindex $headpt 1] 

set pinfo [create_pointer $ns arrow $ptrlen] 
if {$pinfo == -1} { return } 
if {[llength $pinfo] > 1} { 

set ppts (lindex $pinfo 1J 
0 set sub 0 

if {$sub == 1} { 

set tmpa [x2pts_angle $headpt $ tailpt] 
#puts "tmp angle = $tmpa B 
set ppts [points_rotate $tmpa $ppts] 
5 set ppts [points_ translate.. 1st $x $y $ppts] 

#$canvas create line ■ $pointerPoint $symbolPoint n -width 2 -fill blue -tags [list adorner 

key$roiKey] 

} else { 

set ppts [points_rotate $angle $ppts] 
0 set ppts [points_translate_lst $x $y $ppts) 

> 

if {$style == "edit"} { 

set tmps [join [concat $headpt $verts($ptnum) $ tailpt]] 

$ canvas create line $tmps -width 2 -fill yellow -tags [list segment] 
5 } elseif {$style "annotation") { 

$canvas create poly $ppts -outline yellow -width 2 -fill WB -tags [list segment num$ptnum] 

# head handle 

set x [lindex $headpt 0] 

set y [lindex $headpt 1] 
0 set xl [expr $x -3] 

set x2 [expr $x +3] 
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set yl texpr $y -3] 
set y2 Cexpr $y +3] 

$canvas create oval $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle 

head num$ptnum] 
5 # tail handle 

set x [lindex $tailpt 0) 
set y [lindex $tailpt 1] 
set xl [expr $x -3] 
set x2 [expr $x +3] 
10 set yl [expr $y -3] 

set y2 [expr $y +3 3 

$canvas create oval $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle 

tail num$ptnum] 
} else { 

15 $canvas create poly $ppts -outline $linecolor -width 1 -fill $fillcolor -tags [list ant 

pointer key$antkey] 
} 

) 

20 return -1 
} 

proc iat: :ant: : ant_draw_po inter { ns ptnum {style normal}} { 
variable TRACE 

25 if {$TRACE} { puts ■ iat : : ant : : an t_draw_po inter : $ns $ptnum* } 

variable antkey 

variable points 

variable heads 
30 variable verts 

variable tails 
variable dSYMs 
variable dPTRs 
variable kind 
35 variable code 

variable symbol 

variable label 

variable color 
40 variable fillcolor 

variable linecolor 
variable symbolFont 
variable pxl 

45 upvar #0 [join [list [namespace current] $ns canvas) ::] canvas 

set value $heads($ptnum) 

if {$value == " ■ } { return } 
if {$value "auto"} { 
50 set idx [nearest_point $tails ($ptnum) $points] 

if {$idx != $ptnum} { 

# update head and tail 
set heads ($idx) auto 
set verts ($idx) $verts ( $ptnum) 
35 set tails($idx) $tails ($ptnum) 

set dSYMs($idx) $dSYMs <$ptnum) 
set dPTRs ( $idx) $dPTRs ( $ptnum) 
set heads < $ptnum) " " 

set verts ($ptnum) 
50 set tails ($ptnum) " n 

set dSYMs($ptnum) " " 
set dPTRs ( $ptnum) " n 
set ptnum $idx 

return $idx 

55 } 
) 

#puts " ptnum = $ptnum° 

set headpt [lindex $points $ptnum] 
10 set tailpt $ tails ($ptnum) 

if {$tailpt ==»«){ return } 
set draw_symbol $dSYMs ( $ptnum) 
set draw_style $dPTRs ($ptnum) 

'5 #puts n head = $headpt" 

#puts " verts = $verts ( $ptnum) " 
#puts - tail = $tailpt" 

set ptrlen [lindex [x2pts_length $headpt $tailpt] 0] 
10 if (Ulength $verts<$ptnum) ] > 0} { 

set angle [x2pts_angle $headpt [lindex $ver ts ( $ptnum) 0]) 
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} else { 

set angle [x2pt s_angle $headpt $tailpt] 

> 

5 set sub 0 

set x [1 index $headpt 0] 
set y [lindex $headpt 1] 

set pinfo [create_po inter $ns $draw_style $ptrlen] 
10 if {$pinfo == -1} { return } 

if {[llength $pinfoJ > 1} { 
set hppts $pinfo 
if {$sub == 1} { 

set tmpa [x2pts_angle $hea<^pt $tailpt] 
15 #puts "trap angle = $tmpa B 

set ppts [points_rotate $tmpa $ppts] 

set ppts [points^ translate.. 1st $x $y $ppts] 

#$canvas create line * $pointer Point $symbolPoint° -width 2 -fill blue -tags [list adorner 

key$roiKey] 
20 ) else { 

set hppts [points_rotate $ angle $hppts] 

set hppts [ point s_trans la te_lst $x $y $hppts] 

> 

set txnps [list] 
25 lappend tmps $headpt 

set tmps Cconcat $tmps $verts ($ptnum) ] 
lappend tmps $tailpt 
set ppts [makelt $ns $ptnum $ traps] 
if {$style == "edit"} { 
30 set tmps [join [concat $headpt $verts ( $ptnum) $tailpt] ] 

#$canvas create line $ traps -width 2 -fill yellow -tags [list segment] 
if {$draw_style != "none"} { 

$canvas create poly $ppts -smooth true -outline red -width 2 -fill white -tags [list ant 
pointer key$antkey] 

35 $canvas create poly $hppts -outline red -width 2 -fill white -tags [list ant pointer key$antkey] 

) 

} elseif {$style == "annotation" ) { 

#$canvas create poly $ppts -outline yellow -width 2 -fill -tags [list segment num$ptnum] 
if {$draw_style 1= "none"} { 

40 $canvas create poly $ppts -smooth true -outline red -width 2 -fill white -tags [list ant pointer 

key$antkey] 

$canvas create poly $hppts -outline red -width 2 -fill white -tags [list ant pointer key$antkey] 

> 

# head handle 
45 #set x [lindex $headpt 0] 

#set y [lindex $headpt 1] 
#set xl [expr $x -33 
#set x2 [expr $x +3] 
#set yl [expr $y -3] 
50 #set y2 [expr $y +3] 

#$canvas create oval $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle head 
num$ptnum] 

# tail handle 
set x [lindex $tailpt 0] 
55 set y [lindex $tailpt 1] 

set xl [expr $x -3] 
set x2 [expr $x +3] 
set yl [expr $y -3] 
set y2 (expr $y +3] 

50 $canvas create oval $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle tail 

num$ptnum] 
) else { 

if {$draw_style != "none") { 

$canvas create poly $ppts -smooth true -outline $linecolor -width 1 -fill $fillcolor 
55 -tags [list ant pointer key$antkey] 

$canvas create poly $hppts -outline $linecolor -width 1 -fill $fillcolor -tags [list ant pointer 

key$antkey] 
) 

) 

70 } 

set xt [lindex $tailpt 0] 
set yt [lindex $tailpt 13 

75 if {[llength $verts { $ptnum) ] > 0) { 

set angle [x2pts_angle [lindex $verts { $ptnum) end] $tailpt] 
} else { 

set angle [x2pts_angle $headpt $tailpt] 

) 

30 

set anchor [ iat : : ant : : gravity_label $angle] 
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set dx 0 

switch $anchor { 

"e" { set dx -$pxl } 
■w" { set dx $pxl } 
5 "default" { set dx 0 } 

} 

set symbolfill $fillcolor 
if {$style != "normal 0 } { 
set symbolfill red 

L0 } 

#puts " draw_symbol = $ dr aw_syrribo 1 " 
if { $draw_symbol 1= "none") { 
set ptrtxt ■ " 
switch $draw_symbol { 
L5 "symbol" { set ptrtxt $symbol } 

"label" { set ptrtxt $label } 
default { set ptrtxt "" } 

> 

if {$ptrtxt == nn } { set ptrtxt $draw_symbol } 
20 $canvas create text [expr $xt+$dx] $yt -text $ptrtxt \ 

-font $symbolFont \ 
-anchor "$anchor° \ 

-fill $symbolfill \ 
-tags [list adomer key$antkey] 

25 } 

#$canvas create line [list [expr $xt-4] [expr $yt+4] [expr $xt+4) [expr $yt-4]] -fill red -width 2 
-tags [list adorner key$roiKey] 

#$canvas create line [list [expr $xt+4J [expr $yt+4] [expr $xt-4] [expr $yt-4] ] -fill red -width 2 
-tags [list adorner key$roiKey] 

30 

$canvas raise tail 



return 



) 

35 



proc iat: ;ant: :makelt { ns ptnum pts } { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :makelt: $ns $ptnum $pts n 

40 

variable kind 
variable dPTRs 

variable pxl 
variable px2 
15 variable px3 
variable px4 

set negpts [list) 
set pospts [list] 

calc__size $ns 
set px $pxl 



30 



set offset $px 
55 switch $dPTRs($ptnum) { 

"line" { set offset $px3 } 
default [ set offset $pxl } 

} 

60 set Istpt »• 

set pass 1 

foreach curpt $pts { 

if [$curpt == {}} { continue > 

if {$lstpt == ""} { set lstpt $curpt; continue } 
65 #puts n lstpt = $lstpt" 

#puts " curpt = $curpt" 

set len [lindex [x2pts_length $lstpt $curpt] 0) 

#puts ■ len = $len" 

set ang [x2pts_angle $lstpt $curpt] 
70 #puts 0 ang = $ang n 

set lstx [lindex $lstpt 0) 

set lsty [lindex $lstpt 1) 

set curx [lindex $ curpt 0] 
set cury [lindex $curpt 1] 
75 # zero is the line offset from head 

set zero 0 

if ($pass ==1} { set zero $offset } 
# midline points 

set midtmp [list $zero 0 [expr 0+$len] 0 ] 
30 set midtmp [points_rotate $ang $midtmp] 

set midtmp [points_translate_lst $lstx $lsty $midtmp) 
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# negative X points 

set negtinp [list $zero [expr 0-$pxJ [expr o+$len] [expr 0-$px] ] 
set negtmp [points_jcotate $ang $negtmp] 
set negtmp [point s_translate_lst $lstx $lsty $negtmp3 
5 # positive X points 

set postmp [list $zero [expr 0+$px] [expr 0+$len] [expr 0+$px] ] 

set postmp [point s_rotate $ang $postmp] 

set postmp [point s_translate_lst $lstx $lsty $postmp] 

if {$pass == 1} { 

10 set negpts [list [lindex $midtmp 0] [lindex $midtmp 1]] 

set negpts [concat $ negpts $negtmp] 

set pospts [concat [list [lindex $postmp 2] [lindex $postmp 3] [lindex $postmp 03 
[lindex $postmp 13 ] $pospts] 
} else { 

15 lappend negpts [lindex $negtmp 2) [lindex $negtmp 3] 

set pospts [concat [list [lindex $postmp 2] [lindex $postmp 3]] $pospts] 

} 

set lstpt $curpt 
incr pass 

20 } 

# append midpoint to end 

# reverse the pospts and append to negpts 

set newpts [concat $negpts [lindex $roidtmp 2) [lindex $znidtmp 3] $pospts] 
#puts " newpts = $newpts B 

25 

return $newpts 

> 

proc iat: :ant: :ant_draw_pointer_old {} { 
30 #puts "pointerDraw" 

variable canvas 

variable imageX 

variable imageY 

variable offsetX 
35 variable offsetY 

variable roiKey 

variable points 

variable order 

variable symbol 
10 variable label 

variable center 

variable pointer 

variable size 

variable color 
J 5 variable sorl 

variable linecolor 

variable fillcolor 

variable pointerPoint 

variable angle 
>0 variable symbolPoint 

variable symbolPoints 

variable orderToKey 

variable symbols 

55 variable styleFont Small 

variable styleFontDefault 
variable styleFontLarge 

#set xl (expr $x -53 
50 #set x2 [expr $x +5) 
#set yl [expr $y -53 
#set y2 [expr $y +53 

#$canvas create rect $xl $yl $x2 $y2 -fill ° " -outline yellow -width 2 -tags [list handle $roiKey] 

55 #set fsz [expr round(ceil ( { <$imageX + $imageY)/2) * 0.001 * 48 ))} 
set symbolFont fontDe fault 
switch $size { 

"small" { set symbolFont fontSmall > 
"default" { set symbolFont fontDe fault } 
'0 "large" { set symbolFont fontLarge > 

) 

#set fsz [expr round(ceil ( ( ($imageX + $imageY)/2) * 0.001 * $fptsz ))] 

#puts "font size = $fsz" 

#font configure $symbolFont -size $fsz 

'5 

# Test code . . . 
#drawTestAngles 

#set pt [lindex $points $pointerPoint3 
#puts "pointerPoint = $pointerPoint" 

:0 

set sub 0 
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set ptrlen 0 

set pattern { A (\w\: ) {1, 4>$) 
if ( [regexp $pattern $ symbol] } { 
# subordinate 
5 if {[info exists orderToKey ($ symbol) 3 } { 

set sub 1 

set syrobolPoint $symbolPoints ( $orderToKey { $symbol ) ) 
# NOTE: syrobolPoint stored as 10K relative... 

set symbolPoint [pointsFromlOK $imageX $imageY [list $syrobolPoint] ] 
L0 set syrobolPoint [lindex [pointsTranslate $offsetX $offsetY $syiribolPoint] 0] 

#set ptrlen [lindex [iat: : pointer : :2ptsLength $pointerPoint $syxnbolPoint] 0] 

} 

#puts "symbol « $symbol, key = $orderToKey ( $ symbol ) , keysymbol = $symbols ($orderToKey <$symbol) ) ■ 
#puts "symbolPoint = $symbolPoint" 

L5 } 

set ptrlen [lindex [iat :: pointer : :2ptsLength $pointerPoint $ syrobolPoint] 0] 

set x [lindex $pointer Point 0] 
10 set y [lindex $po inter Point 1] 

set pinfo [iat :: pointer :: pointer $pointer $ptrlen] 
if {$pinfo == -1} { return } 
if {[llength $pinfo] > 1} { 

set ppts [lindex $pinfo 1] 
15 if {$sub == 1} { 

set tmpa [iat :: point er: :2ptsAngle $pointerPoint $symbolPoint] 
#puts w tmp angle = $tmpa" 

set ppts [iat: : pointer :: point sRotate $tmpa $ppts] 
set ppts [iat: : point er: : pointsTranslate $x $y $ppts] 
50 #$canvas create line " $pointerPoint $ symbolPoint" -width 2 -fill blue -tags [list adorner 

key$roiKey] 

} else { 

set ppts [iat: : pointer : :pointsRotate $angle $ppts] 
set ppts [iat: : pointer :: pointsTranslate $x $y $ppts] 

S5 } 

$canvas create poly $ppts -outline $linecolor -width 1 -fill $fillcolor -tags [list adorner 
key$roiKey $order] 
} 

if {"$center$pointer" == "centernone" > { 
10 set ptt $pointer Point 

) else { 

set ptt $symbolPoint 

) 

15 set xt [lindex $ptt 0] 

set yt [lindex $ptt 1] 
set drawtext $symbol 

if {$sorl h "label" } { set drawtext $label } 
if {$sub == 0) { 
iO $ canvas create text $xt $yt -text $ drawtext \ 

-font $symbolPont \ 

-anchor [iat :: pointer : : gravityLabel $angle] \ 
-fill $fillcolor \ 

-tags [list adorner key$roiKey $order] 
>5 #$canvas create line [list [expr $xt-4] [expr $yt+4] [expr $xt+4J [expr $yt-4] ] -fill red -width 2 

-tags [list adorner key$roiKeyJ 

#$canvas create line [list [expr $xt+4] [expr $yt+4] [expr $xt-4] [expr $yt-4]] -fill red -width 2 
-tags [list adorner key$roiKey] 
) 

iO 

> 

proc iat: :ant: :ant_select { ns key } { 
variable TRACE 

>5 if {$TRACE} { puts "iat: :and: :ant_select: $ns $key" > 

variable antkey 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
0 upvar #0 [join [list [namespace current] $ns select_jmode] ::] select_jmode 

set key [string tolower $key] 
#if {$key == "active" } { set key $antkey > 
if {$key == •■} { return } 
5 if {$key == "active") { set key $antkey } 

ant_load $ns $key 

#if {[roiDraw] > 0) { return ) 

set rv 0 

0 

#puts " select_mode = $selectjnode" 
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#$ canvas addtag CURRENT withtag key$antkey 
ant_ erase $ns $key 
an t_draw_s egmen t s $ns 
if { $select_mode =- "edit"} { 
5 set rv [ant_draw_pointers $ns $select_mode] 

an t_draw_sectors $ns 

ant_draw_vertexs $ns 
) else { 

an t_draw_vertexs $ns 
10 set rv [ant_draw_jpo inters $ns $ s elect _mode] 

} 

#drawSymbolHandle 



return $rv 



15 } 



20 



proc iat : : ant : : ant_deselect { ns } { 
variable TRACE 

if { $TRACE} { puts " iat : : ant : : ant_deselect : $ns " } 
variable antkey 

upvar #0 [join [list [namespace current J $ns canvas] ::J canvas 

25 if {$antkey == " - } { return } 

#puts " DESELECTING ANT: $antkey B 
ant_erase $ns $antkey 
ant_draw $ns $antkey 
ant_lower $ns $antkey 



30 



return 



) 



proc iat: :ant: : ant_move_ant_delta { ns dpt } { 
35 variable TRACE 

if {$ TRACE) { puts "iat: sant: jant_move_ant_delta: $ns $dpt" } 

variable points 
variable verts 
40 variable tails 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns select_mode] ::] select__mode 

15 set dx [lindex $dpt 0] 

set dy [lindex $dpt 1] 

#puts 0 before = $points" 

set points [point s_trans late $dx $dy $points] 
30 #puts ■ after « $points" 

if { $select_mode == "annotation") { 

foreach {key value) [array get tails] { 

set newpt [point s_trans late $dx $dy [list $value]] 
35 set tails ($key) [lindex $newpt 0] 

set verts ($key) [points_translate $dx $dy $verts ($key) ] 

) 

> 

50 ant_save $ns 



55 proc iat : : ant : : ant_lower { ns key ) { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :ant_deselect: $ns" ) 



70 



75 



variable antkey 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

set key [string tolower $key] 

if [$key == "active") { set key $antkey ) 

$canvas lower key$key 
$canvas raise key$key image 



) 

JO 

# NOTE 
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# doMakeSectors and draWVertexs are called as a pair (and should be called from 

# a single function doMakeHandles .... 

# Calling draWVertexs after doMakeSectors solves the problem of not being able 

# to delete a point because only the sector is clickable. This is because the 
5 # vertexs are drawn on top of the sectors. 

# 

proc iat; :ant: : ant_draw_sectors { ns } { 

10 variable points 

variable kind 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

15 $canvas delete sector 

set sectors [list] 
set Ix 0 ; set ly 0 
set tmps $points 
20 if {$kind == "area") { 

lappend tmps [lindex $points 0] 

) 

set tmps [join $tmps] 
#puts "sector tmps = $tmps" 
25 foreach {x y> $tmps { 

if <$lx == 0 } { 

set lx $x ; set ly $y 
continue 
} else { 

30 set nx [expr <{$x - $lx)/2) + $lx] 

set ny [expr ( ($y - $ly)/2) + $ly] 
lappend sectors [list $nx $ny] 
set lx $x ; set ly $y 

} 

35 

} 

#puts "sectors = $sectors" 
set n 1 

40 foreach {pt} $ sectors { 

set x [1 index $pt 0] 

set y [lindex $pt 1] 

set xl [expr $x -3] 

set x2 [expr $x +3 J 
45 set yl [expr $y -3] 

set y2 [expr $y +3] 

set midx [expr round ( ($x2 + $xl) / 2 )] 

$canvas create poly $midx $yl $x2 $y2 $xl $y2 -fill yellow -outline black -width 1 -tags 
[list handle sector num$n] 
50 incr n 

) 

) 

proc iat: :ant: : ant_draw_jptr_sectors { ns ptnum } { 

55 

variable points 
variable heads 
variable verts 
variable tails 
50 variable kind 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

set sectors [list] 
55 set lx 0 ; set ly 0 

set tmps [list] 

if {$heads($ptnum) == "auto"} { 

set idx [nearest_point $ tails ($ptnum) $points] 
70 set headpt [lindex $points $idx] 

} else { 

set headpt [lindex $points $ptnum] 

) 

set tailpt $tails ($ptnum) 

75 

set tmps [list] 
lappend tmps $headpt 

set tmps [concat $tmps $verts ( $ptnum) ] 
30 lappend tmps $ tailpt 
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set traps [join $tmps] 

#puts " ptr sector traps = $traps" 

foreach {x y} $ traps { 

if {$lx == 0 } { 
5 set lx $x ; set ly $y 

continue 
} else { 

set nx [expr ( ($x - $lx)/2) + $lxj 
set ny [expr (($y - $ly)/2) + $ly] ' 
10 lappend sectors [list $nx $ny3 

set lx $x ; set ly $y 

) 

} 

15 

#puts ■ ptr sectors = $sectors" 
set n 0 

foreach {pt> $sectors { 

set x [lindex $pt 0] 
20 set y [lindex $pt 1] 

set xl [expr $x -3] 

set x2 [expr $x +33 

set yl [expr $y -33 

set y2 [expr $y +3] 
25 set midx [expr round ( ($x2 + $xl) / 2 )1 

$canvas create poly $midx $yl $x2 $y2 $xl $y2 -fill yellow -outline black -width 1 -tags 
[list handle ptrsect num$ptnum sx$n ] 

incr n 

> 

30 } 

proc iat : : ant : : ant_draw_segments { ns } { 

#puts ■ iat : : ant : : an t__draw — segments : $ns n 

35 variable points 

variable kind 
variable heads 
variable tails 

40 upvar #0 [join [list [namespace current] $ns canvas) ::] canvas 

$ canvas delete segment 

set traps [join $points] 
45 if {$kind == "edge"} { 

if {[llength $tmps] < 4} [ return > 

$canvas create line $ traps -width 2 -fill red -tags [list segment] 
} elseif {$kind == -area 0 } { 

if {[llength $tmps] < 6} { return > 
50 $canvas create poly $tmps -width 2 -fill * " -outline red -tags [list segment] 



55 proc iat: :ant: :ant_draw_jvertexs { ns } { 

#puts " iat : : ant : : ant_draw_vertexs ; $ns ■ 

variable points 

50 upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns select_mode] select_mode 

$canvas delete vertex 

55 set shape rect 

if [$select_mode == "edit"] { set shape oval } 

set n 0 

foreach pt $points { 
70 set x [lindex $pt 0] 

set y [lindex $pt 1] 
set xl [expr $x -3] 
set x2 [expr $x +3] 
set yl Cexpr $y -3] 
* 75 set y2 [expr $y +3] 

$canvas create $shape $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle 

vertex num$n] 

.incr n 

} 

30 

#$canvas itemconf igure HANDLE -fill red -outline black 
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proc iat: rant: : ant_draw_j?tr_vertexOLD { ns ptnum > { 

5 variable verts 

foreach {key value) [array get verts] { 
if {$value ==»»}{ continue > 
an t_dr aw_j? t r__ve r t ex $ns $key 

0 > 
> 

proc iat: :ant: :ant_draw_jptr_vertexs { ns ptnum ) { 
variable TRACE 

5 if {$TRACE} { puts "iat: : ant: : an t_draw__p tr_ver texs: $ns $ptnum" } 

variable verts 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
:0 upvar #0 [join [list [namespace current] $ns selectjnode] ::] select_mode 

set shape rect 

if {$select_mode == "edit") { set shape oval ) 

!5 set n 0 

foreach {pt> $verts {$ptnum> ( 

set x [lindex $pt 0] 

set y [lindex $pt 1] 

set xl [expr $x -3] 
i0 set x2 [expr $x +3] 

set yl [expr $y -3) 

$CMW8 l cSate y $stope $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle 
ptrvert num$ptnum vx$n] 
15 incr n 

} 

> 

10 proc iat: :ant: :drawSymbolHandle {> { 
variable TRACE 

if {$TRACE}' { puts "iat: :ant: :ant_vertexs_draw: $ns n > 
variable points 

15 

set pt $symbolPoint 
set x [lindex $pt 0] 
set y [lindex $pt 1] 
set xl [expr $x -3] 
>0 set x2 [expr $x +3] 

set yl [expr $y -3] 

$cLvL l cSate y rect $xl $yl $x2 $y2 -fill yellow -outline black -width 1 -tags [list handle symbol] 

> 

proc iat : : ant : : ant_ver texs^add { ns pts } { 
variable TRACE 

if { $TRACE) { puts ■ iat : : ant : : ant__vertexs_add : $pts 0 } 

50 foreach pt $pts { 

ant_vertex_add $ns $pt 

) 

) 

55 

proc iat : : ant : : ant_vertex_add { ns pt } { 
variable TRACE 

if {$TRACE> { puts "iat: rant: :ant_vertex_add: $ns $pt B } 
70 variable points 

lappend points $pt 

#puts " points = $points" 

75 ) 

proc iat: rant: : ant_insert_ver tex { ns idx newpt } { 
variable TRACE 

if {$TRACE} { puts "iat: :ant: :ant_insert_vertex: $ns $idx $newpt" > 

30 

variable kind 
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variable points 
variable heads 
variable verts 
variable tails 

5 

if {$idx > [llength $points) ) { 
lappend points $newpt 

} else { 

set points [linsert $points $idx $nevpt] 

0 ) 

#puts ■ points = $points" 

# pinned pointers must be readjusted. . . 
set hpts [array names heads] 
5 set hpts Clsort -integer $hpts] 

for {set i texpr $idx+l)> {$i>=0> {incr i -1} { 
set hpt tlindex $hpts $i] 
if {$idx <= $hpt> { 

ant_move_ptr_head $ns $hpt texpr $hpt+l] 

0 } 
> 

ant_ save $ns 

5 } 

proc iat : : ant : : ant_move_vertex { ns idx newpt > { 
variable TRACE 

if { $TRACE } { puts B iat: :ant: :ant_jmove__vertex: $ns $idx $newpt" } 

0 

variable points 

set points fireplace $points $idx $idx $nevipt] 
ant_save $ns 

5 

) 

proc iat: :ant: :ant_delete__vertex { ns idx } { 
variable TRACE 

0 if ($TRACE) { puts 8 iat: :ant: :ant_delete_vertex: $ns $idx" } 

variable kind 
variable points 
variable heads 
.5 variable verts 
variable tails 

# Don • t delete beyond minimum points . . . 
if {$kind == -area") { 
>0 if {[llength $points] « 3) { return } 

} elseif {$kind « "edge"} { 

if {[llength $points] == 2> { return } 

} else { 

if {{llength $points] == 1) { return } 

15 } 

set points [lreplace $points $idx $idx] 

# pinned pointers must be readjusted... 
>0 set hpts [array names heads J 

set hpts [lsort -integer $hpts] 
foreach hpt $hpts { 

if {$hpt > $idx> { 

ant_move_jptr_Jiead $ns $hpt [expr $hpt-ll 

S5 ) 
} 

ant_save $ns 

10 } 

proc iat: :ant: :ant_delete_pointer { ns ptnum ) { 
variable TRACE 

if { $TRACE } { puts "iat: :ant: :ant_delete_pointer: $ptnum" ) 

75 

variable points 

variable heads 

variable verts 
variable tails 
BO variable dPTRs 
variable dSYMs 



WO 2004/057439 - 49 - 

Appendix 2 

set heads {$ptnum) ■■ 

set verts ($ptnum) n " 
set tails ($ptnum) " " 
set dPTRs ($ptnum) ■■ 
5 set dSYMs ( $ptnum) 

ant_save $ns 

) 

0 

proc iat: rant: :ant^ove_j?tr_Jiead { ns idx newidx } { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :ant_jraove_ptr_head: $ns $idx $newidx n } 

5 variable points 

variable heads 

variable verts 

variable tails 
variable dSYMs 
0 variable dPTRs 

if {$newidx == "auto") { 

set neads($idx) "auto" 
ant_save $ns 
5 return 
) 

if {I [info exists heads ($idx) ] > { return -3 } 
if {$heads($idx) return -3 } 

10 if {$idx =» $newidx) { return -1 } 

if {$heads($idx) «= "auto") { set heads($idx) $idx } 



15 



p n 
n u 
o a 



#puts "heads (idx) = $heads ($idx) • 
#puts °tails(idx) = $tails ($idx) ■ 

set heads ($newidx> $newidx 

set tails ($newidx) $ tails ($idx) 
set verts ($newidx) $verts($idx) 
set dSYMs($newidx) $dSYMs($idx) 
10 set dPTRs ( $ new idx) $dPTRs($idx) 

set heads ($idx) ■ ■ 
set tails ($idx) 
set dSYMs($idx) 
15 set dPTRs($idx) 

array set verts [list] 

ant_save $ns 

SO return $newidx 

} 

proc iat: :ant: : ant_roove_ptr_vert { ns ptnum vertn newpt } { 
variable TRACE 

>5 if {$TRACE} { puts "iat: :ant: : antjnove_ptr_vert : $ns $ptnum $vertn $newpt 
variable verts 

set vs $verts($ptnum) 
50 set vs [lreplace $vs $vertn $vertn $newpt) 

set verts ($ptnuxn) $vs 

ant_save $ns 

> 

55 

proc iat: rant: : ant _jnove_jptr_tail { ns idx newpt } { 
variable TRACE 

if {$TRACE} { puts n iat: :ant: :ant_jnove_ptr_tail: $ns $idx $newpt B } 

70 variable verts 

variable tails 

set x [lindex $tails($idx) 0] 
set y [lindex $tails($idx) 1] 
75 set dx [expr (lindex $newpt 0] - $x] 

set dy [expr [lindex $newpt 1] - $y] 

set verts (Sidx) [point s_trans late $dx $dy $verts ($idx) ] 



set tails ($idx) $newpt 

30 

ant_save $ns 
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proc iat: :ant: : ant__inser t_jptrvert { ns ptnum vertn newpt } { 
variable TRACE 

5 if {$TRACE> { puts "iat: :ant: : ant_inser t_ptrver t : $ns $ptnum $vertn $newpt M > 
variable verts 
set vs $verts ( $ptnum) 

10 

if {$vertn >= [llength $vs] > { 

lappencJ vs $newpt 
) else { 

set vs [linsert $vs $vertn $newpt] 

15 } 

set verts ( $ptnum) $vs 



#puts " points = $points" 
ant__save $ns 



20 



} 



proc iat: :ant; : ant_.de let e_ptrvert { ns ptnum vertn } { 
variable TRACE 

25 if {$TRACE} { puts * iat : : ant : : ant_delete_ptrvert : $ptnum $vertn" } 

variable verts 

set vs $ver ts ( $ptnum) 
30 set vs [lreplace $vs $ vertn $vertn] 

set verts ($ptnum) $vs 



ant_save $ns 



35 ) 



proc iat r :ant: : roiSymbolMove { fromPt toPt } { 
#puts "roiSymbolMove" 
variable canvas 
40 variable symbolDirty 
variable symbolPoint 

$ canvas delete symbol 
set symbolPoint $toPt 
45 set symbolDirty 1 

roiSave 

return 0 

50 ) 

proc iat: :ant: :roiReadAllXML { raw } { 
variable channels 
if {$raw =« BB ) ( 
55 if <$channels !» "M { 

incr channels 

if {$channels > 90) { set channels 65 } 

) 

return 

60 } 

if {$channels ==»«>{ 
roiDeleteAll 

iat : : ant : : xml : : roiReadAll $raw 
} else { 
65 set num $channels 

set char t format %c $num] 

set channels w $char : ■ 

iat : : ant : : xml : : roiReadAll $raw 

set channels $num 
70 incr channels 

if {$channels > 90} {set channels 65) 

) 



75 proc iat: :ant: :noop { args } { 
#puts "NOOP: $args B 

> 



80 proc iat: :ant: :roiViewSet { nv ) ( 
#variable view 
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switch — exact $nv { 
■none" { 

set view "none* 

) 

5 default { 

set view "all" 

> 

> 

} 

0 

proc iat: :ant: :ant__dump { ns lvl } { 

puts ■ iat : : ant : : ant__dump : $ns ■ 

set str [ant_make_all $ns $lvl] 
5 puts $str 

> 

proc iat: :ant: :ant_dump_svg { ns lvl > { 
0 puts n iat : : ant : : ant_dump_svg : $ns ■ 

set str [ant_jmake_svg_all $ns $lvl] 
puts $str 

5 } 

proc iat : :ant: :ant_dump_keys { ns } { 
pu t s 0 iat : : ant : : ant_dump_keys : $ns " 

0 upvar #0 [join (list [namespace current] $ns orders] orders 

set lstl Hist] 
set lst2 [list] 

for each (key value) [array get orders] { 
5 lappend lstl $key 

lappend lst2 $value 
puts "key $key = $value° 

) 

#set 1st [lsort -dictionary $lst] 

0 

#puts "keys = $lst" 

) 

5 

if {0} { 
> 

iat.axyp.txt_ 
>0 package require BWidget 
package feo_uire Img 
package require base 6 4 
#package require tkdnd 

>5 

namespace eval iat ( 

font create fontSmall -family helvetica -size 16 
font create fontDefault -family helvetica -size 16 
font create fontLarge -family helvetica -size 16 

30 

# for cut /copy /paste 
variable tmp_.ant_copy 

> 

55 

source iat . icons . tcl 
source iat . canvas . tcl 
source iat . thumbs . tcl 
source iat. ant. tcl 
70 source iat.tex.tcl 

namespace eval iat:: dialog { 

variable TRACE 0 

variable ref_list [list NONE] 
75 variable ref__combo w 0 

variable ref__name "NONE" 

variable ref_file 

variable ref_tree ■ " 

variable ref_code M w 
30 variable ref_.symbol ■ 9 

variable ref_label B n 
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variable grp~tree B " 

) 

source iat . dialog . groups . tcl 
5 source iat .dialog. borders. tcl 

source iat . dialog . dataref . tcl 

source iat. dialog. doc. tcl 

source iat .var . js4svg.tcl 

source iat . var . todo . tcl 
0 source iat. var. splash. tcl 

namespace eval iat::app { 

variable TRACE 0 

variable DEM01 0 
5 variable BATIK 0 # must also turn menu off in js4svgos 

variable SQRIMG 0 

variable SERVER 0 

variable SERVER^ONCE 0 

variable SERVER^STATE WAIT 
0 variable id 0 

variable version "0.8.4" 

variable rsrc__url B " 

variable init_url ■/■ 

variable use_javascript_f ile 1 

5 ) 

# This starts the tcl httpd server... 
if {$: :iat: :app: :SERVER> { 

set : : iat : : app : : SERVER^STATE WAIT 
■ 0 set : :iat: :app: :SERVERJDRL 

source . / t clht tpd/bin/ht tpd . tcl 

} 

proc iat: :app: :proc { ns and args } { 
15 variable TRACE 

if {$ TRACE) { puts "iat: :app: :proc: $ns $cmd $args" > 

upvar #0 [join [list [namespace current] $ns window] ::} window 

10 switch $cmd { 

"configure" { 

foreach {key value) $args { 
switch — $)cey { 

"-url" { url_open_url $ns $value } 
j 5 "-resources" { url_ set_resources $ns $value ) 

«-init_url" { url_set_init_url $ns $value } 
"-scale" { set_scale $ns $value ) 

) 

) 

>0 ) 

"cget" { 

switch — [lindex $args 0] { 

"-window" { return $window } 

) 

35 ) 

"dump" { 

[namespace current] :: dump $ns 

) 

default { 
60 ) 
) 

return {) 

) 

65 

proc iat: : app: -.create { path ) { 
variable id 
variable DEMOl 
variable version 
70 variable SERVER 

variable SERVER_STATE 

if <$path == ".") { set path "° ) 
set wid [incr id] 
75 set wid »iat$wid" 

# splash screen . . . 
wm iconify . 
if ($DEM01) { 
80 app_8plash $wid 

) 
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toplevel $path.$wid -borderwidth 2 
vmi minsize $path.$wid 400 400 
wm geometry $path.$wid 600x400 
wm title $path.$wid "IAT v$version" 

set path $path.$wid 

#puts "path = $path" 



set ns [namespace current] : : $wid 
namespace eval $ns { 
variable window 
variable splash 1 
variable svg_pkg 0 

variable open_url ■/■ 
variable image_url 
variable ants__url 
variable image_f rame 

variable image__canvas 

variable image__scale 100 

variable toolbar__state_url 1 
variable toolbar_state_edit 1 
variable toolbar_state_view 1 

, variable toolbar_state_symlbl 1 
variable toolbar_state_cs 1 
variable toolbar_state_cap 1 
variable status_label •* 
variable entry — url 0 " 
variable entry_view n " 
variable entry_inview aa 
variable entry_code 
variable entry_symbol ua 

variable entry_J.abel 
variable entry_caption 00 
variable entry_cs_class " B 
variable entry„c s_tumor •■ 
variable entry_cs_node 
variable entry_cs_metastasis 
variable entry_cs_note " ■ 

} set cmd "proc [namespace current] :: $wid { cmd args } {eval [namespace current] : :proc $wid \$cmd 
\$args> ■ 

namespace eval : : $cmd 



5 upvar #0 (join [list $ns window] ::] window 
set window $path 

upvar #0 [join [list $ns image_frame] ::] image_frame 
upvar #0 [join [list $ns image_canvas] :;] image_canvas 
0 upvar #0 [join [list $ns status_label] ::] status_label 

upvar #0 [join (list $ns entry_url] entry_url 
upvar #0 [join [list $ns entry_view] ::] entry_view 
upvar #0 [join [list $ns entry_inview] ::] entry_inview 
upvar #0 [join (list $ns entry_codeJ entry_code 
5 upvar #0 [join [list $ns entry_symbol 1 ::] entry_symbol 
upvar #0 [join [list $ns entry_label] ::] entry_label 
upvar #0 [join [list $ns entry_caption] ::] entry_caption 

upvar #0 [join [list $ns entry_cs_class] ::] entry_cs_class 

i0 upvar #0 [join (list $ns entry_cs_tumor ] ::} entry_cs_tumor 

upvar #0 [join (list $ns entry_cs_node] ::] entry_cs_node 

upvar #0 [join [list $ns entry_cs_metastasis] ::] entry_cs_metastasis 

upvar #0 [join [list $ns entry_cs_.no te] entry._cs_note 



J5 menu $path.menubar -type menubar 

$path.menubar add cascade -label Pile -menu $pa th. menubar . file -underline 0 
$path. menubar add cascade -label Edit -menu $path. menubar .edit -underline 0 
$path.menubar add cascade -label View -menu $path. menubar .view -underline 0 
$path. menubar add cascade -label Settings -menu $path. menubar .settings -underline 0 

'0 $path. menubar add cascade -label Help -menu $path. menubar .help -underline 0 
if { I $DEM01 ) { 

$path. menubar add cascade -label Debug -menu $path. menubar .debug -underline 0 

> 



'5 #export menu 

menu $path. menubar .export -tearoff 0 

$path. menubar. export add command -label "SVG Package" -underline 0 \ 

-command " iat : : app : : app_export__svgpkg $wid " 
$path. menubar. export add command -label * Image B -underline 0 \ 
J 0 -command - iat : : app : : app_export_image $wid ■ 

$path. menubar. export add command . -label "Postscript" -underline 0 \ 
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-command ■ iat : : app : : app_expor t_ps $wid" 
$path* menubar. export add command -label "HTML: Default Wrapper" -underline 0 \ 

-command "iat: :app: : app_export w html_def ault $wid" 
$path - menubar . export add command -label "HTML: Quiz Wrapper" -underline 0 \ 

-command "iat : :app: :app_export_html_quiz $wid" 
#end export menu 

#file menu 

menu $path. menubar . f ile -tearoff 0 

$path. menubar. file add command -label "New" -underline 0 \ 
-command ■ iat : : app : : app_new" 

$path. menubar. file add command -label "Open Image* -underline 0 \ 

-command M iat : : app : : url_open $wid n 
$path. menubar . file add command -label "Open Folder" -underline 0 \ 

-command " iat : : app : : f older_open $wid° 
$path. menubar. file add command -label "Save" -underline 0 \ 

-command ■ iat : : app : : url_save $wid ° 

$path. menubar. file add command -label "Save As..." -underline 5 \ 
-command "iat : :app: :url_save_as $wid" 
$path. menubar , file add separator 

$path. menubar. file add cascade -label "Export..." -menu $path. menubar .export -underline 0 
$path. menubar . f ile add separator 

$path. menubar. file add command -label "Close Image" -underline 1 \ 
-command " iat : : app : : app_close_image $wid" 

$path. menubar. file add command -label "Close Window" -underline 1 \ 
-command n iat : : app : : app_close_window $wid* 
$path .menubar. file add separator 

$path. menubar. file add command -label "Quit" -underline 1 \ 
-command "exit" 
#end file menu 

# edit menu 

menu $path. menubar .edit -tearoff 1 

$path. menubar. edit add command -label "Create Area" -underline 0 \ 
-command ■ iat : : app ; : edit_create $wid area " 

$path. menubar. edit add command -label "Create Edge" -underline 0 \ 
-command tt iat : : app : : edit_create $wid edge " 

$path. menubar. edit add command -label "Create Point" -underline 0 \ 
-command ■ iat : : app : : edit_create $wid point " 
$path. menubar .edit add separator 

$path. menubar .edit add command -label "Groups" -underline 0 \ 

-command * iat : : app : : dialog_groups $wid" 
$path. menubar .edit add separator 

$path. menubar .edit add command -label "Edit Borders" -underline 0 \ 
-command " iat : : app : : dialog_borders $wid" 

# end edit menu 

# view menu 

set image_scale_var [join [list iat:: app $wid image_scale] ::] 
menu $path. menubar. view -tearoff 1 

$path. menubar .view add radio -label "25%" -underline 0 \ 
-variable $image_scale_var -value 25 \ 
-command ■ iat : : app : : scale_image $wid° 
$path. menubar .view add radio -label "50%" -underline 0 \ 
-variable $image_scale_var -value 50 \ 
-command » iat : : app : : scale_image $wid ° 
$path. menubar .view add radio -label w 100%" -underline 0 \ 
-variable $image_scale_var -value 100 \ 
-command "iat : :app: :scale_image $wid" 
$path. menubar. view add radio -label "200%" -underline 0 \ 
-variable $image_scale_var -value 200 \ 
-command "iat: :app: :scale_image $wid" 
$path. menubar. view add radio -label "400%" -underline 0 \ 
-variable $image_ scale_var -value 400 \ 
-command * iat : : app : : scale_image $wid ■ 

# end view menu 

# settings menu 

#puts "state_var « $state_jvar" 

menu $path. menubar .settings -tearoff 1 

# url toolbar 

set state_var [join [list iat:: app $wid toolbar_state_url] ::] 
$path. menubar. settings add check -label "Show URL" -underline 0 \ 
-variable $state_var \ 

-command " iat : : app : : toggle_toolbar $wid $path tb_url {urll urle) $state_var" 

# edit toolbar 

set state_var [join [list iat:: app $wid toolbar__state_edit] ::] 
$path. menubar. settings add check -label "Show Edit" -underline 0 \ 
-variable $state_var \ 

-command "iat : :app: : toggle_toolbar $wid $path tb_edit { selectl select2 blankl new_point 
_edge new_area blank2 pointerl pointer2 ptrsty ptrpin ptrsym blank3 color move delete blank4 } 
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$state_vetr a 

# view toolbar 

set state_var [join [list iat: :app $wid toolbar_state_view3 ::] 
$path. menubar. settings add check -label "Show View" -underline 0 \ 
5 -variable $state_var \ 

-command n iat: :app: : toggle_toolbar $wid $path tb_vw { vwl we invwl invwe} $state_var" 

# code & symbol & label toolbar 

set state_var [join [list iat: : app $wid toolbar_state_symlbl] ::] 
$path .menubar . settings add check -label "Show FCAT" -underline 0 \ 
10 -variable $state_var \ 

-command " iat : : app : : toggle_toolbar $wid $path tb_sl { fcatl codl code syml syme Ibll lble codb} 

$state_var° 

# TNM Cancer staging shorthand 

set state_var [join [list iat: :app $wid toolbar_state_cs] 
15 $path. menubar. settings add check -label "Show TNM" -underline 0 \ 
-variable $state_var \ 

-command " iat : : app : : toggle_toolbar $wid $path tb_cs { tnml classl classe tl te nl ne ml me notel 
notee) $state_var" 

# caption toolbar 

20 set state_var [join [list iat: : app $wid toolbar_state_cap] 

$path. menubar, set tings add check -label "Show Caption" -underline 0 \ 
-variable $state__var \ 

-command " iat : : app : : toggle_toolbar $wid $path tb_cap {capl cape) $state_var ■ 

# end settings menu 

25 

# help menu 

menu $path. menubar .help -tearoff 0 

$path. menubar. help add command -label "About..." -underline 0 \ 
-command ■ iat : : app : : help_about $wid" 
30 $path. menubar. help add command -label "To Do" -underline 0 \ 

-command "iat: :app: :help_todo $wid" 

# end help menu 



# debug menu 
35 if {!$DEM01} { 

menu $path. menubar .debug -tearoff 1 

$path. menubar. debug add command -label "Console" -underline 0 \ 

-command ■ iat : : app : : show_console $wid " 
$path. menubar .debug add command -label "Dump Ants" -underline 0 \ 
40 -command " iat : : app : : dump_ants $wid n 

$path. menubar .debug add command -label "Dump SVG" -underline 0 \ 

-command "iat: :app: :dump_svg $wid" 
$path. menubar. debug add command -label "Dump Keys" -underline 0 \ 

-command ■ ia t : : app : : dump_keys $wid B 

45 } 

# end debug menu 



$path configure -menu $path. menubar 



50 

# URL toolbar 

set url_tb [frame $path.tb_url -relief solid -bd 1] 

#puts n url_tb = $url_tb» 
label $url_tb.urll -text "URL:" 
55 pack $url_tb.urll -side left 
Entry $url_tb.urle -width 60 

pack $url_tb.urle -side left -pady 2 -fill x -expand 1 

$url_tb . ur le conf igure -command ■ iat : : app : : ur l_enter $wid ■ 
set entry_url $url_tb.urle 
60 # linux 

#dnd bindtarget $url_tb.e text/plain <Drop> "iat: :app: :url_drop $wid %A %a %T %W %D° 

# windows 

# and bindtarget $url_tb.e Piles <Drop> n iat : : app : : ur l_drop $wid %A %a %T %W %D" 1 

# dnd bindsource $url_tb.e CF__HDROP { return [pwd] } 
65 pack $url_tb -side top -anchor nw -fill x -expand 0 



# edit toolbar 

set edit_tb [frame $path. tb_edit -relief solid -bd 1] 
set tmp [button $edit_tb.selectl \ 
70 -image [image create photo -data $iat: : icons :: Select Solid] \ 

-command "iat: :app: :edit_select $wid annotation" ] 
pack $tmp -side left 
set tmp [button $edit_tb.select2 \ 

-image [image create photo -data $ iat :: icons : :SelectHollow] \ 
75 -command "iat: :app: :edit_select $wid edit" ] 

pack $tmp -side left 
set tmp [button $edit_tb . blankl \ 

-image [image create photo -data $iat: : icons: : Blank] \ 
-relief flat \ 
30 -command »• ] 

pack $tmp -side left 
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set tmp [button $edit_tb.new_point \ 

-image [image create photo -data $iat: : icons :: Point] \ 
-command B iat : : app : : edit_create $wid point ■ ] 
pack $tmp -side left 
5 set tmp [button $edit_tb.new_edge \ 

-image [image create photo -data $iat: : icons :: Line] \ 
-command 0 iat : : app : : edit_create $wid edge 0 ] 
pack $tmp -side left 
set tmp (button $edit_tb.new_area \ 
10 -image [image create photo -data $iat :: icons :: Polygon] \ 

-command a iat: :app: :edit_ create $wid area" ] 
pack $tmp -side left 
#set tmp [button $edit_tb.new_rectangle \ 

# -image [image create photo -data $iat: : icons Fullscreen] \ 
15 # -command " n ] 

# pack $tmp -side left 

#set tmp [button $edit_tb.new__circle \ 

# -image [image create photo -data $iat: : icons :: Circle] \ 

# -command nw ] 
20 # pack $tmp -side left 

set tmp [button $edit_tb.blank2 \ 

-image [image create photo -data $iat: : icons :: Blank] \ 
-relief flat \ 
-command B B ] 
25 pack $tmp -side left 

set tmp [button $edit_tb. pointer 1 \ 

-image [image create photo -data $iat: : icons : : Pointer Single] \ 
-command " iat : : app : : edit_create_pointer $wid single" ] 
pack $tmp -side left 
30 set tmp [button $edit_tb.pointer2 \ 

-image [image create photo -data $iat: : icons : : PointerMultiple] \ 
-command "iat : :app: : edi t_create_po inter $wid multiple" ] 
pack $tmp -side left 
set tmp [button $edit_tb.ptrsty \ 
35 -image [image create photo -data $iat :: icons : : PointerHead] \ 

-command " iat ; : app : : edi t_ptr_style $wid " ] 
pack $tmp -side left 
set tmp [button $edit_tb.ptrpin \ 

-image [image create photo -data $ iat :: icons :: Pin] \ 
10 -command "iat : :app: :edit_ptr__pin $wid" 3 

pack $tmp -side left 
set tmp [button $edit_tb.ptrsym \ 

-image [image create photo -data $ iat :: icons: : Symbol] \ 
-command "iat : :app: :edit_ptr_symbol $wid" ] 
15 pack $tmp -side left 

set tmp [button $edit_tb.blank3 \ 

-image (image create photo -data $iat :: icons :: Blank] \ 
-relief flat \ 
-command ° " ] 
50 pack $tmp -side left 

set tmp [button $edit_tb. color \ 

-image [image create photo -data $ iat :: icons: : Color] \ 
-command " iat : : app : : edi t_ant„color $wid " 3 
pack $tmp -side left 
55 set tmp [button $ edi t_tb. move \ 

-image [image create photo -data $iat :: icons : .-Move] \ 
-command n iat : : app : : edit_move $wid tt ] 
pack $tmp -side left 

#set tmp [button $edit_tb.copy \ 
50 # -image [image create photo -data $iat: : icons :: Copy] \ 

# -command " iat : : app : : edit_ant_copy $wid" ] 

# pack $tmp -side left 
#set tmp [button $edit_tb. paste \ 

# -image (image create photo -data $iat: : icons :: Blank] \ 
55 # -command "iat: :app: :edit_ant_paste $wid" ] 

# pack $tmp -side left 

set tmp [button $ edi t_tb. delete \ 

-image [image create photo -data $iat icons :: Cut] \ 

-command "iat: :app: :edit_ant_cut $wid" 3 
r 0 pack $tmp -side left 

set tmp [button $edit_tb.blank4 \ 

-image [image create photo -data $ iat :: icons : :Blank3 \ 

-relief flat \ 

-command ] 
'5 pack $tmp -side left 

pack $edit_tb -side top -anchor nw -fill x -expand 0 

# view toolbar 

set vw_tb [frame $path.tb_vw -relief solid -bd 1] 
SO #puts "sl_tb = $sl_tb" 

label $vw_tb.vwl -text "VIEW: " 
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pack $ vw_tb . vwl -side left 

CoinboBox $vw_tb . we -width 12 -values [list ALL NONE] -modifycmd "iat: :app: :edit_set_view $wid B 
set entry_view $vw_tb . vwe 
$entry_view setvalue first 
5 pack $vw_tb . vwe -side left -fill x -expand 0 
#set tmp [button $vw__tb.vwb \ 

# -image [image create photo -data $iat :: icons :: Code] \ 

# -command "iat : :app: : edit_update_view $wid° ] 
#pack $vw_tb . vwb -side left -padx 4 

10 label $vw_tb . invwl -text ■ IN VIEWS :" 

pack $vw_tb. invwl -side left 

Entry $vw_tb . invwe -width 48 -command " iat : : app : : edit_set_inview $wid° 
set entry_inview $vw_tb. invwe 

pack $vw_tb . invwe -side left -fill x -expand 0 -pady 4 
15 pack $vw_tb -side top -anchor nw -fill x -expand 0 



# code & symbol & label toolbar 

set sl_tb [frame $path.tb_sl -relief solid -bd 1] 
20 #puts "sl_tb m $sl_tb° 

label $sl_tb.fcatl -text "FCAT" 

pack $sl_tb.fcatl -side left 

label $sl_tb.codl -text "CODE: ■ 

pack $sl_tb.codl -side left 
25 Entry $sl_tb.code -width 14 -command "iat : :app: :edit_set_code $wid" 

set entry_code $sl_tb.code 

pack $sl_tb.code -side left -fill x -expand 0 
label $sl_tb.syml -text "SYMBOL:" 
pack $sl w .tb.syml -side left 
30 Entry $sl_tb . syme -width 8 -command " iat ;: app s : edit_set_ symbol $wid" 
set entry_symbol $sl_tb.syme 

pack $sl_tb.syme -side left -fill x -expand 0 
label $sl_tb.lbll -text "LABEL: " 
pack $sl_tb.lbll -side left 
35 Entry $sl_tb.lble -width 32 -command "iat : :app: :edit_set_label $wid" 

set entry_label $sl„tb. lble 

pack $sl_tb.lble -side left -pady 2 -fill x -expand 0 
set tmp [button $sl_tb.codb \ 

-image [image create photo -data $ iat :: icons: : Code] \ 
10 -command " iat : : app : : edit_ant_data $wid" ] 

pack $sl_tb.codb -side left -padx 4 
pack $sl_tb -side top -anchor nw -fill x -expand 0 



15 # TNM Cancer Staging shorthand 

set cs_ tb [frame $path.tb_cs -relief solid -bd 1] 

#puts °sl_tb = $sl_tb" 

label $cs_tb.tnml -text "TNM" 

pack $cs__tb.tnml -side left -pady 2 
SO label $cs_tb.classl -text -STAGE: 0 

pack $cs_tb.classl -side left 

Entry $cs_tb.classe -width 4 -command "iat :: app: : edit_.se t_cs_class $wid" 
set entry_cs_class $cs_tb.classe 
pack $cs_tb.classe -side left -fill x -expand 0 
>5 label $cs_tb.tl -text "T" 
pack $cs_tb.tl -side left 

Entry $cs_tb.te -width 4 -command "iat: : app: : edit_.se t__cs_tumor $wid n 
set en try__cs_ tumor $cs_tb.te 
pack $cs_tb.te -side left -fill x -expand 0 
>0 label $cs_tb.nl -text "N* 
pack $cs_tb.nl -side left 

Entry $cs_tb . ne -width 4 -command "iat: : app r : edi t_set_cs_node $wid " 
set entry_cs_node $cs_tb.ne 
pack $cs__tb.ne -side left -fill x -expand 0 
>5 label $cs_tb.ml -text "M" 
pack $cs_tb.ml -side left 

Entry $cs_tb.me -width 4 -command "iat : :app: : edit_set_cs_metastasis $wid" 
set entry_cs_metastasis $cs_tb.me 
pack $cs_tb.me -side left -fill x -expand 0 
'0 pack $cs__tb -side top -anchor nw -fill x -expand 0 
label $cs_tb.notel -text "NOTE" 
pack $cs_tb . notel -side left 

Entry $cs_tb.notee -width 42 -command "iat: :app: :edit_set_cs_note $wid B 
set entry_cs_note $cs_tb.notee 
r 5 pack $cs_tb.notee -side left -fill x -expand 0 

pack $cs_tb -side top -anchor nw -fill x -expand 0 

# caption toolbar 

set cap_tb [frame $path.tb_cap -relief solid -bd 1] 
10 #puts «sl_tb = $sl_tb° 

label $cap__tb.capl -text "CAPTION: " 
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pack $cap_tb.capl -side left -padx 2 -pady 2 
text $cap_tb.cape -width 72 -height 2 
set entry„caption $cap_tb.cape 

pack $cap_tb.cape -side left -pady 2 -fill x -expand 0 
5 pack $cap__tb -side top -anchor nw -fill x -expand 0 

set f [frame $path.f -relief solid -bd 13 

pack $f -side top -anchor nw -fill both -expand 1 

.0 set f [frame $path.f.f -relief solid -bd 1] 

pack $f -side top -anchor nw -fill both -expand 1 

set image_frame $f 

#puts " image^f rame = $image_f rame" 

.5 set c [iat: : canvas :: create $f] 

set image_canvas $c 

# help bar 

label $path.help -text "Ready."; pack $path.help -side left 
!0 set status_label $path.help 

$image_canvas configure -callbackselect * [namespace current] : :handle__ant_jselect $wid B 

$image_canvas configure -callbackdeselect "[namespace current J ; :handle_ant_des elect $wid" 
$image_ canvas configure -status $status_label 

:5 

#$image_canvas configure -callbackserver "[namespace current] : :url_save_server $wid" 
if {$ SERVER) { 

$image_ canvas configure -callbackserver "[namespace current] : :url.save„server $wid" 

'0 set fh [open ". /tclhttpd/htdocs/ index, htm" w] 

puts $fh "<html>\n M 
puts $fh "<head>\n" 

puts $fh "<title>IAT SERVER</title>\n" 

puts $fh "<meta http-equiv=\ " REFRESH \ " content=\ n 5 ; URL= index .htm \ " >\n B 
5 puts $fh "</head>\n" 

puts $fh °<body>\n" 

puts $fh " IAT server waiting for session..." 
puts $fh "</body>\n" 
puts $fh "</html>\n" 
0 close $fh 

} 

return [join [list [namespace current] $wid] ::] 

) 

5 

proc iat : : app : : app__new { } { 
return [create . J 

) 

0 proc iat: :app: : app_close_image { ns } { 
variable TRACE 

if { $TRACE) { puts ■ iat : : app : : app_close_image : $ns n } 

variable SERVER 
5 variable SERVER_STATE 

upvar #0 [join [list [namespace current] $ns iraage_canvas ] image_canvas 
upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 
upvar #0 [join [list [namespace current] $ns ants_uri] ::] ants_url 
upvar #0 [join [list [namespace current] $ns entry_urlj ::] entry_url 

0 

set SERVER_STATE WAIT 
if {$ SERVER) { 

set fh [open ■ . /tclhttpd/ht docs /index. htm" w] 

puts $fh °<html>\n" 
5 puts $fh "<head>\n" 

puts $fh "<title>IAT SERVER</title>\n" 

puts $fh "</head>\n" 

puts $fh "<body>\n ,f 

puts $fh "IAT server session closed..." 
0 puts $fh "</body>\n" 

puts $fh "</html>\n" 
close $fh 



> 



$image_canvas close 



set image_url 
set ants_url "" 
$entry_url delete 0 end 
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proc iat: :app: :app_close_window { ns } { 
variable TRACE 

if {$TRACE} { puts "iat: :app: .-app_close_window: $ns" ) 
app__close_image $ns 
5 destroy .$ns 

} 

proc iat: :app: : ur l_set_resources { ns url } { 
variable TRACE 

.0 if {$TRACE} { puts "iat: :app: :url_set_re sources: $ns $url" } 

variable rsrc_url 
set rsrc_url $url 

) 

.5 

proc iat: :app: :url_ set_JLnit_url { ns url } { 
variable TRACE 

if {$TRACE} { puts "iat;:app: :url_set_init_url: $ns $url n } 

iO variable init_url 
set init_url $url 

> 

proc iat : : app : : url__enter { ns > { 
>5 variable TRACE 

if { $ TRACE } { puts ■ iat : : app : : url_enter : $ns • } 

upvar #0 [join [list [namespace current] $ns entry„url] ::] entry_url 

JO set url [$entry_url get] 

url_open_url $ns $url 

} 

*5 proc iat : : app : : url_drop { ns action actions type widget data } { 

puts tt iat: :app: :drop_url: $ns $action $actions $type \ M $data\ n " 

if {[string match text/* $typej > { 
set url [string trim $data] 
10 $widget delete 0 end 

$widget insert 0 $url 
url_open_url $ns $url 
) else { 

15 } 
} 

proc iat: :app: :url_open { ns ) { 
variable TRACE 
SO if ($TRACE) { puts "iat: :app: :url_open: $ns" ) 

variable SERVER 
variable init_url 

upvar #0 [join [list [namespace current] $ns open_url] ::] open_url 

S5 

if {$SERVER> { 

set init_url . /tclhttpd/htdocs 

> 

50 set newi_url [tk_getQpenFile -title "Open image/iat file." \ 

-initialdir $init_url \ 
-defaul text ens ion ".svg fl \ 

-filetypes { {IMG { .png .PNG .tif .TIF .jpg .JPG}> {SVG {.svg .SVG)) ) ] 

55 if {$new_url ==«"){ return ) 

puts 0 new_url » $new_url n 

set new_url B f ile: $new_url" 
url_open_url $ns $new_url 

70 

) 

proc iat: :app: :url_open_url { ns {url " ■ ) ) { 
variable TRACE 

75 if {$ TRACE) { puts -iat: :app: :url_open_url: $ns $url n ) 

variable SERVER 
variable SERVER_STATE 

upvar #0 {join [list [namespace current] $ns image_canvas] ::] image_canvas 

JO upvar #0 [join [list [namespace current] $ns image_url] : : ] image„url 

upvar #0 [join [list [namespace current) $ns ants_url] ::] ants_url 
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upvar #0 [join [list [namespace current) $ns entry_url] entry_url 
upvar #0 [join [list [namespace current] $ns open_url] ::] open_url 

app_close_image $ns 

5 

if {[regexp {"file:} $url]> { 

$entry_url delete 0 end 
$entry_url insert 0 $url 
regexp { A f ile: ( . *} } $url m path 
10 #puts ■ path = $path" 

regexp {.*\.(\S+)$} $path m ext 
#puts ■ ext = $ext" 
set ext [string tolower $ext] 
switch -regexp $ext { 
15 B png|jpg|tif ■ { 

set tmp "" 
set image_url $url 
url_load_image $ns $image_url 
set tmp [url_for_ants $ns $image_url] 
20 • if ($tmp != «") { 

set ants^url $tmp 
url_loa<3L_ants $ns $ants_url 

) 

set open_url [file dimame $path] 

25 } 

"svg" { 

set tmp ■ " 

set ants_url $url 

set tmp [url_for_image $ns $ants_url] 
30 puts " url_for_image = $tmp B 

if {$tmp 1= nu > { 

set image_url $tmp 

url_loa6Uimage $ns $image_url 

) 

35 url_loadLants $ns $ants_url 

set operu url [file dirname $path] 

> 

default { 

if {[file isdirectory $path] } { 
$0 folder_open_url $ns "f ile:$path" 

> 

) 

) 

> else { 

J5 puts "ERROR, non-file url: $url" 

} 

$image_canvas redraw 

50 if {$SERVER> { 

set SERVER_STATE GO 
url_save_server $ns 

#set fh [open ». /tclhttpd/htdocs/ index.htm" w] 
35 #puts $fh "<html>\n" 

#puts $fh M <head>\n° 

#puts $fh «<title>IAT SERVER</title>\n" 

#puts $fh "<meta http-equiv=\ ° REFRESH \ n content=\"5;uTlL=index.htm\">\n" 
#puts $fh "</head>\n° 
50 #puts $fh "<body>\n" 

#puts $fh °IAT server session started..." 
#puts $fh "</body>\n" 
#puts $fh "</html>\n" 
#close $fh 



55 



) 

proc iat r :app: :url_for_ants { ns url } { 
70 variable TRACE 

if { $ TRACE } C puts "iat: :app: :url_for_ants: $ns $url" } 

regexp { A f ile: ( . *) \ .\S+$} $url m base 

75 set tmp "$base.svg" 

if {[file exists $tmp] } { return "file:$tmp" } 
set tmp *$base.SVG" 

if {{file exists $tmp] ) { return "file:$tmp" } 



30 

} 



return ■ 
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proc iat : :app: :url_for_image { ns url } { 
variable TRACE 

if ($TRACE) { puts B iat; :app: :url_for__image: $ns $url° } 

5 regexp (*f ile: ( .*) \ . \S+$) $url m base 

set tmp B $base.png" 

if {[file exists $tmp] } { return n f ile: $tmp° } 
set tmp B $base.PNG" 

L0 if {[file exists $tinp] > { return " f ile:$tmp B } 

set tmp B $base.tif ■ 

if {[file exists $tmp] } { return °file:$trop" } 
set tmp B $base.TIF° 
L5 if {[file exists $tmp) > { return »file:$tmp B } 

set tmp °$base.jpg" 

if {[file exists $tmp] } { return ■ f ile: $tmp- } 
set tmp n $base.JPG M 

>0 if {[file exists $tmp] } { return *file:$tmp" } 



return 



) 



25 proc iat: :app: :url_loadLimage { ns (url ■ » ) } { 
variable TRACE 

if { $TRACE } { puts "iat: :app: :url_load_image: $ns $url" } 

upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 
30 upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 

if ($url =!= BB } ( set url $image_url } 

if {[string match file:* $url] } { 
35 regexp {^file:{.*)> $url m path 

$image_canvas configure -file $path 
} else { 



40 ) 



) 



proc iat: :app: :url_load_ants { ns {url ■ " } } { 
variable TRACE 

if {$ TRACE} { puts "iat: :app: :url_loaoL_ants: $ns $url" } 

45 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 



if {[regexp (*file:) $url] > { 
50 regexp { A file:(.*)> $url m path 

if ([file exists $path] > { 
set svg BB 

set fh [open $path rj 
55 set svg [read $fh] 

close $fh 

# regexp out the <IAT>. . .</IAT> data, 
set ants BB 

regexp {<IAT>. *</IAT>} $svg ants 
60 # parse here. . . pass reference. . . 

set doc [tex: : create -xml $ants] 
$doc parse 
#$doc dump; exit 

$image_canvas annotations reacUcmds $doc 
65 #$image_canvas annotations parse $ants 

edit_update_view $ns 
> 



70 ) 



75 



80 



proc iat: :app: : url_save_server { ns } { 
variable TRACE 

if {$ TRACE} { puts "iat: :app: :url_save: $ns° } 

variable SERVER_ONCE 
variable SERVER^STATE 

upvar #0 [join [list [namespace current] $ns image__urlj ::] image_url 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 



if {$SERVER_STATE 1= M GO B ) { return ) 
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set svgfil© [file rootname [file tail $image_url] ] .svg 

set fh [open " . /tclhttpd/htdocs/ index. htm" w] 
5 puts $fn ^html^n" 
puts $fn "<head>\n 0 

puts $fn »<title>IAT: $svgf ile</title>\n* 

puts $fh "<1 — <meta http-equiv=\ ° REFRESH \ ° content=\ 0 5 j URL= index . htm\ " > — >\n» 

puts $fh a </head>\n" 
.0 puts $fh "<body>\n" 

puts $fh "<embed name=VSVG0\ B type= \ ° image / s vg+xml \ ° widths \ • 1 00% \" height=\ "100%\- 
src=\ M $svgfile\ , '></embed>\n ,, 

puts $fb u <noembed>No SVG embed — </noembed>\n» 

puts $fh "•c/body^n 0 
.5 puts $fh "</htiiil>\n" 

close $fh 

set rvs [$image_canvas svg] 
#puts $rvs 
10 set menu [1 index $rvs 7] 

set ants [lindex $rvs 8] 



set uPath ■ . / tclhttpd/htdocs /update . xml ■ 
set fhx [open $uPath w] 
15 puts $fhx °<g id= 'NEWANTS r >\n° 

puts $fhx ■ $menu\n$ants n 
puts $fhx "</g>\n" 
close $fhx 



SO #if {$SERVER_ONCE == 0> { 

# url_save $ns 

# incr SERVER_ONCE 
#) 

55 > 



proc iat: :app: :url_save { ns > { 
variable TRACE 

if { $TRACE } { puts ■ ia t : : app : : ur l_save : $ns ■ > 

10 

variable SERVER 
variable SERVER.. STATE 

upvar #0 [join [list [namespace current) $ns image_canvas) ::] image_canvas 
upvar #0 [join [list [namespace current] $ns image_urlj ::] image_url 
15 upvar #0 [join [list [namespace current] $ns ants_url) ::) ants_url 



set SERVER_STATE WAIT 



if {$ants_url «=■"){ 
30 url — save_as $ns 
return 

) 



if {[file exists $ants_url] } { 
35 set choice [tK_messageBox \ 

-title "Overwrite file?" \ 

-message "Overwrite existing annotation (.iat) file?" \ 
-icon question \ 
-type yesno \ 
50 -default yes ] 

if {$choice != "yes"} { return > 

} 

#set ants [$image_canvas annotations make all 0] 
55 set ants [app_jmake_svg $ns] 

url_save_ants $ns $ants_url $ants 



set SERVER_STATE GO 

} 

70 

proc iat; :app: :url_save_as { ns } { 
variable TRACE 

if {$TRACE} { puts *iat: :app: :url_save_as: $ns n ) 

75 upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 
upvar #0 [join [list [namespace current] $ns ants_url] ::] ants_url 

regexp {*file:(.*)> $image_url m image_path 
80 set init_path [file dimame $image_path] 

set init_file [lindex [file split [file rootname $image_path] ] end] 
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set new_url [ tk_getSaveFile -title "Save SVG file:" \ 
-initialdir $init_path \ 
-initialfile $init_file \ 
-defaultextension ".svg" \ 
5 -filetypes {{-SVG 8 {svg SVG)}} ] 

if {$new_url == ""} { return ) 

if {[file exists $new_url]} { 
L0 set choice [tk_messageBox \ 

-title "Overwrite file?" \ 

-message "Overwrite existing SVG file?" \ 

-icon question \ 

-type yesno \ 

L5 -default yes ] 

if {$choice 1= "yes"} { return ) 

} 

set ants_url B f ile:$new_url" 
20 #set ants [$image_canvas annotations make all 2] 
set ants [app__make_svg $ns) 

url_save__ants $ns $ants — url $ants 

) 

>5 

proc iat ; :app: :url_save_ants { ns url ants } { 
variable TRACE 

if {$TRACE} { puts "iat: :app: :url_save_ants: $ns $url \n $ants n } 



50 



if {[regexp {^file:} $url] } { 

regexp {~files(.*)} $url m path 



if {[file exists »$path.old"] } { 
35 file delete "$path.old» 

} 

if {[file exists $path] } { 

file rename $path "Spath.old" 

} 

10 

set fh [open $path w] 
#puts $fh °<?xml versionaX'l.ON" ?>" 
#puts $fh "<image>" 
puts $fh $ants 
15 #puts $fh "</image>\n" 

close $fh 

} 

} 

30 

proc iat : : app : : f older_open ( ns } { 
variable TRACE 

if {$TRACE} { puts ■ iat : : app : : f older_open : $ns" } 

55 upvar #0 [join [list [namespace current] $ns open^url] ::] open_url 

set new_url ( tk_chooseDirectory -title "Open image folder..." \ 
-initialdir $open__url 3 

30 if {$new_url == ■ ■ ) { return } 
#puts n new_url = $new_url" 

set new_url "f ile;$new_url" 
#url_open_url $ns $new_url 
55 folder_make_contact_sheet $ns $new__url 

) 

proc iat : :app: :folder_open_url { ns new_url } { 
70 variable TRACE 

if {$TRACE} { puts 0 iat : : app : : f older_open_url : $ns $new__url n } 

upvar #0 [join [list [namespace current] $ns open_url] ::] open_url 

75 if {$new__url ==""){ return } 

folder_make_contact_sheet $ns $new_url 

} 

50 

proc iat: :app: :folder_make_contact_sheet { ns url } { 
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variable TRACE 

if {$ TRACE) ( puts *iat: :app: :folder_make_contact_sheet: $ns" } 

upvar #0 [join [list [namespace current] $ns image_frame] ::) image_frame 
5 upvar #0 [join [list [namespace current] $ns image__canvas] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns open_url] ::] open_url 

app__close_image $ns 

10 #folder_make_thumbnails $ns $url 

#puts "image canvas = $iroage_canvas" 
$iroage_canvas destroy 

set c [iat: : thumbs :: create $image_f rame] 
15 set image_canvas $c 

$image_canvas configure -callbackselect " iat : : app : : contac t_sheet_select " 
$ image__canva s configure -url $url 

return 

20 

regexp { A f ile: ( . *) } $url m srcPath 

set tmpPath [file join $srcPath 00_TMP] 

set tmbPath [file join $tmpPath T) 

25 set files [glob [file join $tmbPath *.JPG]] 

pack forget $image_frame 
set wpath $image__f rame 
destroy $image — frame 

30 

set image_frame [frame $image_frame) 
set csf $image_frame 

canvas $csf .canvas -width 10 -height 10 \ 
35 -yscrollcommand [list $csf .yscroll set] 

scrollbar $csf .yscroll -orient vertical \ 
-command [list $csf .canvas yview] 

pack $csf .yscroll -side right -fill y 

pack $csf .canvas -side left -fill both -expand true 
40 #grid $top . c . canvas $ top. c. yscroll -sticky news 

pack $csf -side top -fill both -expand true 

set f [frame $csf .canvas. f -bd 0] 

$csf .canvas create window 10 10 -anchor nw -window $f 

45 

set n 1 

foreach {fl f2 f3> $files { 

if {[file exists $f 1] } { 
50 set tmbl [image create photo -file $fl] 

set btnl [button $f.tmb$n -image $tmbl -command "iat : :app: :contact_sheet__s elect $ns $fl n ] 
} else { 

set btnl [button $f .trob$n -text X] 

) 

55 incr n 

if {(file exists $f2] > { 

set tmb2 [image create photo -file $f2] 

set btn2 [button $f.tmb$n -image $tmb2 -command "iat; :app: : contact_sheet_select $ns $f2*J 
60 } else { 

set btn2 [button $f .tmb$n -text X] 

) 

incr n 

65 if {[file exists $f31) { 

set tmb3 [image create photo -file $f3] 

set btn3 [button $f.tmb$n -image $tmb3 -command "iat: :apps : contact_sheet_select $ns $f3 n ] 
> else { 

set btn3 [button $f . tmb$n -text X] 

70 } 

incr n 

grid $btnl $btn2 $btn3 -padx 4 -pady 4 
#pack $btn 

75 } 

tkwait visibility $csf. canvas 
set bbox [grid bbox $f 0 0] 
set incr [lindex $bbox 3] 
80 set width [winfo reqwidth $f ] 

set height [winfo reaheight $f] 
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$csf. canvas config -scrollregion "0 0 $width texpr $height+50] ■ 
$csf .canvas config -yscrollincrement 20 

$csf .canvas config -width $width -height [expr $height+50) 

5 } 

proc iat : -*app: :contact__sheet__select { ns tfile ) { 
variable TRACE 

if ($TRACE) { puts "iat: :app: : con tact_sheet_s elect : $ns $ tfile" } 

.0 

set tparts [file split [file rootname $tfile)] 
set iparts [lrange $tparts 0 [expr [llencfth $tparts]-4} ] 
#set ifile [file join $iparts] 
lappend iparts [lindex $tparts end]. PNG 
.5 set path [eval "file join $iparts"I 

#puts "image file = $path° 



set app [app_new] 

$app configure -url ■ f ile : $path B 

>0 } 



proc iat : : app : : app_make__svg { ns } { 
>5 variable TRACE 

if {$TRACE} { puts "iat: :app: : app_jnake_s vg : $ns" } 

variable DEMOl 
variable SQRIMG 
30 variable SERVER 
variable BATIK 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 

S5 upvar #0 [join [list [namespace current] $ns svg_pkg] ::] svg_pkg 

# current view. . . 

upvar #0 [join [list [namespace current] $ns entry_view] ::] entry_view 
set view_vals [$entry_view cget -values] 
JO set view_text [lindex $view_vals [$entry_view getvalue] ] 

set dtd "<!D0CTYPE svg PUBLIC \ ■ -//W3C//DTD SVG 20010904//EN\" 
\ n http://www.w3.org/TR/2001/REC-SVG-20010904/E>TD/svgl0.dtd\" \[ < 1 ATTLIST svg xmlns:a3 CDATA # IMPLIED 
a3:scriptImplementation CDATA #IMPLXED> <! ATTLIST script a3 : script Implementation CDATA #IMPLIED> \]>\n" 

15 

set rvs [ $image_canvas svg] 
#puts $rvs 

set bL [lindex $rvs 0] 

set bT [lindex $rvs 1] 
30 set bR [lindex $rvs 2] 

set bB [lindex $rvs 3] 

set bColor [lindex $rvs 4] 

set imgx [lindex $rvs 5] 

set imgy [lindex $rvs 6] 
55 set menu [lindex $rvs 7] 

set ants [lindex $rvs 8] 

if {[regexp {*file:} $image_url] ) [ 

regexp { A f ile :(.*)} $image_url m path 
60 set parts [file split $path] 

} else { 

return "ERROR in image_url" 

) 

65 # Use to generate square output (for KA scale drag-and-drop) 

set recx $imgx 
set recy $imgy 
set handles ■ 0 
if {$ SQRIMG) { 
70 if {$recx > $recy) { 

set recy $recx 
} else { 

set recx $recy 

> 

75 set bL 0; set bT 0; set bR 0; set bB 0 

set handles B onload=\ u handleOnLoadScale(evt)\" onzoom«\"handleUpdateScale (evt) \ n 
onscroll=\ "handleUpdateScale ( evt ) \ ■ onresize=\ "handleUpdateScale (evt ) \ " n 
} 

if {$ SERVER) { 
8 0 set handles 0 onload- \ " handleOnLoad ( evt ) \ " " 

) 
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append handles " xmlns=\ B http: //www. w3 .org/ 2000/ svg\" xmlns :xlink=\°http: //www. w3 .org/ 1999 /xlink\" 
xmlns : a3=\ "http : / /ns . adobe . com/AdobeSVGViewerExtensions/3 . OA* a3 : scriptImplementation=\ "Adobe \ ■ • 

set svg 

5 

set bL [expr round ($izngx * $bL) ] 
set bT [expr round <$imgy * $bT)] 
set bR [expr round ($imgx * $bR) ] 
set bB [expr round ($imgy * $bB>] 

10 

set alone "no* 

if {$svg_pkg} { set alone "yes" ) 

append svg n <?xml versions' 1 .0 1 standalone= ' $alone ' ?>\n B 
append svg "Sdtd" 

15 #append svg B <svg width=> * [ expr $imgx+$bI*+$bR] ' height=' [expr $imgy+$bT+$bB] ' >\n n 

# previous lines didn't allow dynamic port changes... 

append svg "<svg viewBox=*0 0 [expr $recx+$bL+$bR] [expr $recy+$bT+$bB] ' preserveAspectRatio=»xMinYMin 1 
$handles " 

#append svg "xmlns :xlink=» http: //www. w3c.org/1999/xlink' * 
20 append svg ">\n" 

# metadata 

append svg "<metadataxl \[CDATA\ [\n" 
append svg " <IAT>\n" 

append svg [$image_canvas annotations make all 3] 
25 append svg " </IAT>\n" 

append svg n \1 \] ></metadata>\n" 

if {$DEM01> { 

append svg "<rect width=' [expr $recx+$bL+$bRj », height*' [expr $recy+$bT+$bB] ' style= ' f ill :white; 
30 stroke: red; stroke-width :2px' />\n" 

append svg "<text x='$bL' y='$bT» style= ' font-size : 32 ; text-anchor : start; f ill :red' >N/A in IAT 
Technology Evaluation</text>\n" 
append svg "</svg>\n" 
return $svg 

35 } 

# javascript 

variable use_javascript_f ile 
if {$use_javascript_f ile) { 

set jsfile [file join . js4svg.js] 
40 if {[file exists $jsfile]} { 

set fh [open $ jsfile r] 
set js [read $fhj 
close $fh 
append svg $js 

45 } 

} e'lseif {$DEMOl} { 

# don't include javascript... 
} else { 

append svg [ ia t : : var_s t r__j s 4 svg ] 

50 } 

append svg °<1 — END_JAVA — >\n* 



append svg "<rect width='[expr $recx+$bL+$bR] • height*' [expr $recy+$bT+$bB] ' sty le= 1 fill: $bColor; 
55 stroke: red? stroke-width:2px' />\n" 

#puts "exportlmageAsSVG: annotationSource = $annotationSource" 
if {0} { 

set iatfile [lindex $parts end] 
set chnames [array names channelFileMap] 
50 set chnames [Isort -dictionary $chnames] 

f oreach chname $ chnames { 

set endchfile [lindex [file split $channelFileMap($chname) ] end] 
set display "none" 

if {$endchfile == $iatfile) { set display "inline" } 
55 #puts ■ exportlmageAsSVG add channel: $endchfile" 

append svg u <image id= • $endchf ile-channel ' style= » display : $display' x='$bL' y='$bT' width* ' [expr 
$imgx) ' height=' [expr $imgy] ' xlink:href=» ./$endchf ile»>\n a 
append svg "</image>\n" 

} 

7 0 > elseif {$svg_pkg} { 

#puts "image: $path = [file size $path] » 
set input [open $path rj 

fconfigure $input -translation binary -encoding binary 
set img_str [base64 :: encode [read $input]J 
? 5 close $ input 

#puts $img_str 

append svg "<image id= ' default-channel ' style=' display: inline' x=»$bL' y='$bT' width='[expr $imgx] • 
heights' [expr $imgy)'\n" 
10 append svg "xlink : href =\" data : ;base64, \n$img_str\» >\n" 

append svg °</image>\n M 
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} else { 

append svg "<image id=* default-channel • style=' display: inline' x='$bL' y='$bT' width='[expr $imgx] ' 
height=' [expr $imgy] 1 xlink:href=» ./[lindex $parts end]'>\n" 
append svg B </image>\n B 

5 } 

# stop and go buttons for server delivery. . . 
if {$ SERVER} { 

set u I expr $recx/25] 
10 set v [expr $recx/50] 

set z [expr $recx/100] 

append svg "<rect x='[expr $bL+$v] » y=' [expr $recy-$bB-$u] » width= • [expr $u*6] 1 heights • [expr $u] * 
style=* fill: white; stroke: white; stroke-width: $z 1 />\n" 

append svg a <rect id= • updateStopButton • x=»[expr $bL+$v] * y^'Cexpr $recy-$bB-$u] ' width='[expr $u] • 
15 height=' [expr $u] ' style=' fill: red; stroke:black; s troke -width :2px; visibility: inherit; » 
onclick= 1 antRef reshStop ( ) ' />\n" 

append svg "<polygon id^'updateStartButton' points= ' [expr $bL+$v] , [expr $recy-$bB] [expr 
$bL+$v] , [expr $recy-$bB-$u] [expr $bL+$v+$u] , [expr $recy-$bB-$v] 1 style=' fill: green; stroke:black; 
stroke-width : 2px ; visibility : hidden; ' onclick= 1 antRef reshStart ( ) 1 />\n" 
10 append svg D <text id= ' currentViewText ' x= ■ [expr $bL+$u+$u] 1 y= ' [expr $recy~$bB-$z] ' 

style=* font -size :24; •> $view_text </text>\n" 
} 

append svg "<g id= ' SVG ANTS » >< ! — START_ANTS — >\n° 
15 # context menu 
if {$BATIK} { 

# do not insert menu. . . v 
append svg $ants 
> else { 
SO append svg $menu 

if U$SERVER> { 

append svg $ants 

> 

) 

15 append svg "</gxl — END_ANTS — >\n" 

# append svg °<l — END_ANTS — >\n° 
append svg "</svg>\n" 
#puts $svg 

#set fh [open $f ileNameSVG w] 
10 #puts $fh $svg 

#close $fh 

#set antpath [file dirname $path] 

#append antpath " /update . xml ■ 
t5 #puts "antpath = $antpath B 

#set fh [open $antpath w] 

#puts $fh "<g id='NEWSVGANTS'>\n" 

#puts $fh "$menu\n$ants" 

#puts $fh "</g>\n" 
•0 #close $fh 

# Generate sample html file from svg — 

#exportSVGDefaultHTMLPage [file root $fileNameImage] .HTM [lindex [file split $f ileNameSVG) end] $svg 
5 return $svg 



proc iat: :app: : app_export_ps { ns } { 
variable TRACE 

0 if {$ TRACE} { puts ■ iat : : app : : app_export_ps : $ns" } 

upvar #0 [join [list [namespace current] $ns image_canvas) ::) image_canvas 
upvar #0 [join [list [namespace current] $ns image_url] ::J image_url 

5 if {[regexp { A file:> $image__url] } { 

regexp {''file: { . *) } $image_url m path 

set img_file [file rootname $path] 

append irog_file "_x.ps" 

#puts " img_file = $img_file" 
0 } else { 

return "ERROR in app_export_ps • 

) 

if {[file exists $img_f ile] } { 
5 set choice [tk__messageBox \ 

-title "Overwrite file?" \ 

-message "Overwrite existing Postscript (.ps) file?" \ 
-icon Question \ 
-type yesno \ 
0 -default yes ] 

if {$choice 1« B yes") { return } 
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> 

$image_canvas postscript $img_file 

5 } 

proc iat : : app : • app_export_image { ns } { 
variable TRACE 

if ($TRACE) { puts M iat: :app: :app_export_image: $ns" > 



10 



upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 



if {[regexp {^file:} $image_url] } { 
15 regexp {^£ ile: ( . *> } $image_url m path 

set img_file [file rootname $path] 
append img_file "_CANVAS.jpg" 
#puts " img_file » $img_file" 
} else { 

20 return "ERROR in image_url" 

> 

if {[file exists $img_f ile] } { 
set choice [tkjnessageBox \ 
25 -title "Overwrite file?" \ 

-message "Overwrite existing image (.jpg) file?" \ 
-icon question \ 
-type yesno \ 
-default yes ] 
30 if {$choice 1= "yes") { return } 

} 

set img [$image_canvas image] 
35 $img write $img_file -format JPEG 
) 

proc iat : : app : : app_export_svg { ns } { 
40 variable TRACE 

if {$TRACE} { puts "iat: :app: :app_export_svg: $ns" } 

variable DEMOl 

if {$DEM01) { , , , 

45 tk_messageBox -type ok -message "This option is not available in the IAT Technology Evaluation. 

return 

> 

upvar #0 [join [list [namespace current) $ns image_canvas ] ::] image_canvas 

50 upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 

if {[regexp {~file:) $image_url] ) { 

regexp {~f ile: ( . *) ) $image_url m path 
set svg_file [file rootname $path] 
5 5 append svg_f ile " . svg " 

puts " svg_file = $svg_file" 
) else { 

return "ERROR in image_url" 

) 

60 

if {{file exists $svg_f ile] ) { 
set choice [tkjnessageBox \ 

-title "Overwrite file?" \ 

-message "Overwrite existing SVG {.svg) file?" \ 
65 -icon question \ 

-type yesno \ 
-default yes ] 
if {$choice != "yes") { return ) 

) 



70 



set svg [app_make_svg $ns] 
puts $svg 



set fh [open $svg_file w] 
7 5 puts $fh $svg 
close $fh 



80 proc iat: :app: :app__export_j3vgpkg { ns ) { 
variable TRACE 
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if {$TRACB} { puts ° iat : : app : : app_expor t_svgpkg : $ns" ) 

variable DEMOl 
if {$DEMOl} { 

tk_messageBox -type ok -message "This option is not available in the IAT Technology Evaluation, 
return 

> 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 

upvar #0 (join [list [namespace current] $ns image_url] ::] image_url 

upvar #0 [join [list [namespace current] $ns svg_pkg] ::] svg_pkg 

if {[regexp {^file:} $image_url] } { 

regexp {^f ile: ( . *) ) $image_url m path 

set svg_file [file rootname $path] 

append svg_file "_pkg.svg" 

#puts " svg_file = $svg_file" 
) else { 

return "ERROR in image_url" 

) 

if {[file exists $svg_file)) { 
set choice [tk_messageBox \ 

-title -Overwrite file?" \ 

-message "Overwrite existing SVG package (_j?kg.svg) file?" \ 
-icon Question \ 
-type yesno \ 
-default yes ] 
if {$choice != "yes"} { return ) 

} 



set svg_pkg 1 
set svg [app_make_svg $ns] 
set svg_pkg 0 
5 #puts $svg 

set fh [open $svg_file w] 
puts $fh $svg 
close $fh 

0 

) 

proc iat: :app: : app_export_html_def ault { ns } { 
variable TRACE 

5 if {1} { puts "iat: :app: :app_export_html_de fault: $ns" > 



variable DEMOl 

if l tk^essageBox -type ok -message "This option is not available in the IAT Technology Evaluation, 
return 

} 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 

upvar #0 [join [list [namespace current] $ns svg_pkg] ::] svg_pkg 



if {[regexp {^file:) $image_url] } { 

regexp {*file:{.*)> $image_url m path 

# read only. . . 

10 set svg_file [file rootname $path] 

append svg_file ".svg" 
puts ■ svg_file « $svg_file" 

# write only. . . 

set html_file [file rootname $path] 
i5 append html_file "_default.htm" 

puts ■ html_file = $html_file" 
) else { 

return "ERROR in image_url" 

) 



'0 



to 



if {[file exists $html_f ile] } { 
set choice [tkjnessageBox \ 

-title "Overwrite file?" \ 

-message "Overwrite existing HTML file (_default.htm) file?" \ 
-icon question \ 
-type yesno \ 
-default yes ] 
if {$choice != "yes") { return > 

> 

set svg [$image_canvas annotations make all 3] 
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#puts $svg 
set orders [list] 
set state "NONE" 
set lines [split $svg "\n"] 
5 for each line $ lines [ 

if {[regexp {*\s*</roi>} $line] ) { 
set state NONE 

if {[regexp { A \s*<roi } $line3 } { 
0 regexp {-\s*<roi\s+.*order=\" <\S+)V > $ line match order 

lappend orders $order 
#puts 0 order = $order" 
set state ROX 

> 

5 } 

set orders [Isort -dictionary $orders] 
set traps [list] 
foreach order $orders { 
0 lappend tmps \'$orderV 

> 

set arr n \[[join $tmps -,"]\]" 
puts • arr = $arr" 

5 set html "<html>\n" 

# javascript 

variable use_javascript_f ile 
if {$use_javascript_file> { 
0 set jsfile [file join . js4html.js] 

if {[file exists $jsfile] } { 
set fh [open $jsfile r] 
set js [read $fh] 
close $fh 
5 append html $js 

> 

} elseif {$DEM01> { 

# don't include javascript.*. 
} else { 

0 append html [iat : :var_str_js4html] 

> 

set ants_html " " 

.5 append html "<head> B 
append html n </head>" 
append html »<body>" 

append html "<table width='100%' height=« 100% ' border= 1 1 >\n» 
append html "<tr width=' 100% ' >\n" 
i0 aSendhtml -<td width- -70%' xerribed width=« 100%' height- '100%' src= • $svg_f ile' name='image 
puginpage== • ht tp : / /www . adobe . com/svg/ ■ ></ td> \n " 

:: t fo^::'hlute; f or m .>Xn <ta b le W idt h =.100%. b^-l»- valign-TOP- border=.l.>Xn. 
append html - <trxtdxinput type=' button' value= ' Toggle Mouseovers' 
>5 onclick=\ "window. antToggleMouseOverAll ($arr , 1) ; \°x/tdx/tr>\n" 
append html • <tr><tdxinput type= ' button ' value='Hide All' 
onclick=\ " window. antSetShowAll ($arr, false, 1) ; \-x/tdx/tr>\n B 

append html " <trxtdxinput type= 'button' value* ' Show All ' 
onclick=\ "window. antSetShowAll <$arr, true, 1) ; \"x/tdx/tr>\n" 
50 append html " <trxtd><br>ANNOTATIONS</tdx/tr>\n" 
append html $ants_html 
#append html »</td>\n</tr>\n" 

append html - <trxtdxbr>CAPTION</tdx/tr>\n" 1TWwni n . .m™i**n 

append html " <tr width- • 100% • xtd width- • 100% • height='100%' align-'LEFT' valign= TOP ><p 
55 id- ' caption • >no caption</px/tdx/tr>\n" 

append html ■ •c/tables^VK/formsAn'' 
append html «</tdx/trx/table>\n» 
append html "</body>\n u 
70 append html "</html>" 
#puts $html 

set fh [open $html_file w] 
puts $fh $html 
7 5 close $fh 

return 



30 proc iat: :app: :app_export_html__old_olcL_old {} { 
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set lines [split $svg "Vn"] 
set iatimage 
set iatchannels {list) 
set iatviews [list] 
5 set order ** 
set symbol 
set label " " 
set caption 
set IMG 0 
10 set SYM 0 

set ALL 0 
set OK 0 

for each line $ lines { 
#puts "line: $line* 

15 if {[regexp {^Ns^imageNs+id^ 1 (\S*) -channel 1 } $ line match xxx ]> { 

lappend iatchannels $xxx 

} 

if {[regexp {^\s*<image\s+id= ' |\S*) -channel 1 .* 'display :inline» } $ line match xxx ]} { 
lappend iatimage $xxx 

20 > 

# svg symbol contains iat symbol label and captoin for each order 

# note : the dangers of a polluted namespace . . . 
if {[regexp {~\s*</symbol>} $line ]} { 

#puts "save symbol: $order, $symbol / $label, $caption" 
25 set txtdatas($order) [list symbol $symbol label $label caption $caption] 

set order ** 

set symbol " " 

set label 8 ■ 

set caption ° w 
30 set SYM 0 

} 

if ($SYM) { 

if {[regexp {<symbol>\s* (\S*) \s*</symbol>} $ line match xxx ]) { 
set symbol $xxx 
35 #puts "html found symbol: $symbol" 

> 

if {[regexp {<label>\s* { . *) \s*</label>> $ line match xxx ]} { 
set label $xxx 

#puts "html found label: $label" 

40 } 

if {[regexp {<caption>\s* ( . *> \s*</caption>) $line match xxx }} { • 
set caption $xxx 

#puts "html found caption: $caption" 

) 

45 } 

if {[regexp {~\s*<symbol\s+id= ' (\S+) » } $line match xxx ]} { set order $xxx; set SYM 1 > 

# Annotation data taken from All view 

if {[regexp {<! — \s*end\s+All-view) $line ]} { set ALL 0 ) 
if {$ALL> { 

50 if {[regexp {<g\s+id=» ALL- (\S+) ' } $ line match xxx] } { 

set order $xxx 
#puts "html order «= $order° 
set OK 1 

> 

55 } 

if {$OK> { 

if {[info exists txtdata] } { unset txtdata } 
regexp { * ( \S+ : ) ) $order match okey 
if {[info exists txtdatas ($okey) ] } { 
60 set 1st $txtdatas($okey) 

array set txtdata $txtdatas ($okey) 
} else { 

set 1st [list symbol none label none caption none] 
array set txtdata $lst 

65 } 

#puts "load symbol = $lst B 

set str " <tr width= , 100% , xtd width^'100% 1 align= ' LEFT 1 >< input type= ' checkbox * values" 
onclick=\ ■ setAnnotationVisibility ( this , * $order 1 ) \ " checked > <a 

href =\° javascript :showCaption('$txtdata( caption) ')\">$okey $txtdata{ label) </a> </tdx/tr>\n B 
70 append ants_html $str 

#puts "html ant: $str" 
set OK 0 

} 

if {[regexp {<g\s+id= ■ ALL-view* } $line 3) { set ALL 1 } 
75 # All miat view plus other views 

if {[regexp {<g\s+id=' (\S+) -view 1 } $line match xxx 1) { lappend iatviews $xxx } 

> 

set html B <html>\n n 

80 

# file that contains javascript... 



WO 2004/057439 ~ 72 ~ ji PCT/US2003/017138 

Appendix 2 1 

set jsfile tfile join $iatPath js4html.js] 
set fh [open $ jsfile r] 

append html "<script languages' JavaScript 1 .2* >\n B 
append html "<! — \n* 
5 append html [read $fh] 

append html " \ncurrent__channel = 1 $iat image ' \n" 
append html "// ~>\n" 
append html "</script>\n" 
close $fh 

L0 

append html "<head>" 
append html "</head>" 
append html "<body>° 

append html °<table width= , 100%» height= ' 100% ' borders »l»>\n" 
L5 append html "<tr widths ' 100% » >\n° 

append html "<td width='70%'xembed width= 1 100% ' heights '100%' src=' $f ileNameSVG' name= • image 1 
puginpage= 1 http : / /www . adobe . com/ svg /viewer /install/ 1 x/td>\n" 
append html "<td widths '30%' >\n" 

append html n <f orm names »hilite_form' >\n <table widths • 100% ' heights' 100% ' valign= 'TOP' border s'l'^n" 
10 append html " <trxtd><input type= ' checkbox ' values' * 
onclick=' toggleMouseOvers { this) • >ROLLOVERS</tdx/tr>\n" 

append html ■ <trxtdxbr>CHANNELS</tdx/tr>\n" 
foreach iatchannel $iatchannels { 
25 set checked *" 

if {$iatchannel == $iatimage) { set checked "checked" } 

append html ■ <tr widths' 100% ' xtd widths '100%' aligns » LEFT ' xinput type=* radio' 
name=' channel -group ' values '$ iatchannel • onclick=\" setChannel (this, '$ iatchannel •) \° $ checked > $iatchannel 
</tdx/tr>\n" 
30 } 

append html " <trxtdxbr>VXEWS</tdx/tr>\n" 
foreach iatview $iatviews { 
set checked * n 

35 if ($iatview == "ALL") [ set checked "checked" } 

append html " <tr width- ' 100% • xtd width=»100%' align= ' LEFT 1 xinput type='radio' name= 'view-group' 
values' $iatview' onclick=\ n setViewVisibility (this, '$ iatview* > \" $checked > $iatview </tdx/tr>\n" 
) 

40 append html " <trxtdxbr>MJNOTAT10NS</tdx/tr>\n" 

append html $ants_html 
#append html °</td>\n</tr>\n" 

append html " <trxtdxbr>CAPTION</tdx/tr>\n" 

append html " <tr width* • 100% • xtd width= '100% ' height='100% ' align='LEFT» valign= , TOP , xp 
45 id= 1 caption ' >no caption</px/tdx/tr>\n n 

append html " </table>\n</form>\n" 
append html "</tdx/trx/table>\n" 
append html "</body>\n" 
30 append html "</html>" 

#puts $html 

set fh [open $f ileNameHTML w] 
puts $fh $html 
55 close $fh 
} 

• 

proc iat : : app : : scale_image { ns } { 

60 upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns image_scale] ::] iroage_scale 

$image_canvas configure -scale $image_scale 

55 return 1 

} 

proc iat: :app: :toggle_toolbar { ns p tb tbs var ) { 
70 variable TRACE 

if {$ TRACE) { puts -iat: :app: :toggle_toolbar: $ns $p $tb { $tbs > $var" } 

set r [set $var] 
#puts °$var « $r" 

75 

if {$r == 0} { 

foreach s $tbs { 

#puts " forget: $p.$tb.$s" 
pack forget $p.$tb.$s 

30 } 

frame $p.$tb.xxx 
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pack $p.$tb.xxx 
) else { 

destroy $p.$tb.xxx 
for each s $tbs { 
5 #puts ■ packing: $p.$tb.$s" 

pack $p.$tb.$s -side left -pady 2 -expand 0 

} 
) 

} 

L0 

proc iat: :app: :edit__create { ns kind } { 



variable SERVER_STATE 

L5 upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 

upvar #0 [join [list [namespace current] $ns image^canvas] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns status_labelj ::] status_label 

set SERVER_STATE WAIT 

10 $image_canvas create roi $kind 
set SERVER_S TATE GO 



} 

25 proc iat: :app: :edit_select { ns mode > { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image__canvas 



$image_canvas configure -select $mode 

30 

} 

proc iat: :app: :edit_create_pointer [ ns num } { 

35 upvar #0 [join [list [namespace current] $ns image_urlj ::] image_url 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns status_label] ::] status_label 

$image_canvas create pointer $num 

10 

} 



proc iat: :app: :edit_ptr__style { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
a 5 $image_canvas pointer style 
} 



proc iat: :app: :edit_ptr_jpin { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image__canvas 
50 $image_canvas pointer pin 
) 

proc iat: :app: :edit_ptr_symbol { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image__canvas 
35 $image_canvas pointer symbol 
) 



proc iat : : app : : edit_ant_color { ns } { 
50 upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 

set color [$image_canvas active get color] 
set color [tk^chooseColor -initialcolor $color] 
$ixnage_canvas active set color $ color 

> 

55 

proc iat: :app: :edit_ant__data { ns } { 
variable DEMOl 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
70 upvar #0 [join [list [namespace current] $ns status_label] ::] status_label 
upvar #0 [join [list [namespace current] $ns entry_code] ::] entry_code 
upvar #0 [join [list [namespace current) $ns entry_symbol] ::] entry_symbol 
upvar #0 [join [list [namespace current] $ns entry_label] ::] entry_label 



75 variable DEMOl 

if {$DEMOl} { , t . 

tk^jnessageBox -type ok -message "This option is not available in the IAT Technology Evaluation. 

return 

) 



30 



set 1st [iat: .-dialog: :dialog_edit_data] 
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#puts " 1st o $lsf 

if {$lst == {)> < return } 

$entry_code delete 0 end 
5 $ entry— symbol delete 0 end 
$entry_label delete 0 end 

$entry_code insert 0 [lindex $lst 0] 
$entry_symbol insert 0 [lindex $lst 11 
0 $entry_label insert 0 [lindex $lst 2] 

} 

proc iat : : app : : edit_move { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
$image_canvas move active 

0 } 

proc iat: :app: : edit_ant_copy { ns } { 
variable tmp_ant_copy 

D upvar #0 [join [list [namespace current] $ns iroage_canvas ] ::] image_canvas 

set tmp_ant_copy [$image_canvas annotations make active 0] 
#puts " tmp„ant_copy\n$tmp_ant_copy M 

0 

> 

proc iat: :app: :edit_ant_paste { ns } { 
;5 variable tmp_ant„copy 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::) image_canvas 
$image_canvas annotations paste $tmp_ant_copy 

10 

} 

proc iat: :app: :edit_ant_cut { ns ) { 

15 variable SERVER 

variable SERVER_STATE . 

upvar #0 [join [list [namespace current] $ns image^canvas] ::] image_canvas 

set SERVER_STATE WAIT 
30 edit_ant_copy $ns 

$image_canvas delete active 
set SERVER^ STATE GO 

if {$ SERVER) { 
55 url_save_server $ns 

) 

) 

proc iat: :app: :edit_set_view { ns } { 
50 #puts "iat: :app: :edit_set_view: $ns B 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image T canvas 
upvar #0 [join [list [namespace current] $ns entry_view] ::] entry_vxew 

65 set vals [$entry_view cget -values] 

$image_canvas active set view [lindex $vals [$entry_view getvalue] 3 

> 

proc iat: :app: :edit_update_view { ns {ivwIN B ■ } ) { 
70 #puts "iat: :app: : edit_update_view : $ns" 

upvar #0 [join [list (namespace current] $ns imageTcanvas] ::] image canvas 
upvar #0 [join [list [namespace current] $ns entry_view] ::] entry_view 

75 set vals [$entry_view cget -values] 

set val [lindex $vals [$entry_view getvalue]] 

if {$ivwIN « ■"} { 
} else { 
80 set ret 1 

set ivws [split $ivwIN] 
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for each ivw $ivws { 

if {[lsearch $vals $iyw] < 0} { 
set ret 0 
break 

5 ) 
} 

if ($ret) { return > 

} 

10 #puts "VIEW VALUE = $val" 

set newvals [split [$image_canvas active update view] J 

if {$newvals == [list] > { return > 

set vals [concat [list ALL NONE] $newvals] 

$entry_view configure -values $vals 
15 set idx [lsearch -exact $vals $valj 

if {$idx < 0) { 

$entry_view setvalue first 

> else { 

$entry_jview setvalue ©$idx 

20 } 

#edit_ set_view $ns 

> 

25 

proc iat: :app: :edit_set_inview { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns entry_inview] t:] entry_inview 

30 

$image_canvas active set inview [ $entry_inview get] 

> 

proc iat : : app : : edit^set^symbol { ns } { 

35 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 

upvar #0 [join [list [namespace current] $ns entry__symbol] ::] entry_symbol 

$image_canvas active set symbol [$entry_syiribol get] 

10 

> 

proc iat : :app: :edit_set_label { ns > { 

15 upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image__canvas 

upvar #0 [join [list [namespace current] $ns entry_label] ::] entry_label 

$image_canvas active set label [ $entry_label get] 

>0 } 

proc iat: :app: :edit_set__cs_class { ns > ( 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
>5 upvar #0 (join [list [namespace current] $ns entry_cs_class] :;] entry_cs_class 

$image_canvas active set cs_class [$entry_cs_class get] 

> 

50 

proc iat: :app: :edit_set„cs_tumor { ns > { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns entry_cs_tumor] ;:] entry_cs_tumor 

15 

$image_ canvas active set cs — tumor [$entry__cs_tumor get] 

) 

' 0 proc iat : : app : : edit_set_cs_node { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas ) ::] image__canvas 
upvar #0 [join [list [namespace current] $ns entry_cs_node] ::] entry_cs_node 

5 $image_canvas active set cs__node [$entry_cs_jnode get] 

} 

proc iat: :app: :edit_set_cs_metastasis { ns } { 

0 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
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upvar #0 [join [list [namespace current] $ns entry_cs_metastasis] ::] entry_cs_jnetastasis 
$image__canvas active set cs_jmetastasis [$entry_cs_jmetastasis get] 

5 ) 

proc iat : s app : : edit_set_cs_note { ns } { 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image__canvas 
10 upvar #0 [join [list [namespace current] $ns entry_cs_note] ::] entry_cs_note 

$image__canvas active set cs_note [$entry_cs_note get] 

) 

15 

proc iat: :app: :handle_ant_select { ns } { 
variable TRACE 

if {$ TRACE) { puts "iat: tappr :handle_ant_ select : $ns" > 



20 upvar #0 [join [list [namespace current] §ns image__canvas ] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns entry_inview] ::] entry_inview 
upvar #0 [join [list [namespace current] $ns entry — code] ::] entry_code 
upvar #0 [join [list [namespace current] $ns entry__symbol ] :;] entry_symbol 
upvar #0 [join [list [namespace current] $ns entry_label] ::] entry„label 

25 upvar #0 [join [list [namespace current] $ns entry__caption] ::] entry_caption 



upvar #0 [join [list [namespace current] $ns 

upvar #0 [join [list [namespace current] $ns 

upvar #0 [join [list [namespace current] $ns 

30 upvar #0 [join [list [namespace current] $ns 

upvar #0 [join [list [namespace current] $ns 

$entry_inview delete 0 end 
$entry__code delete 0 end 
35 $entry_symbol delete 0 end 
$entry_label delete 0 end 
$entry_ caption delete 0.1 end 



entry_cs_class] ::] entry_cs_class 
entry__cs_tumor] : : ] entry_cs__tum6r 
entry_cs_node] : : ] entry_cs_node 
entry — cs_roetastasis] ::] entry_cs_metastasis 
entry_cs_jiote] : : ] entry_cs^note 



$entry__cs_class delete 0 end 
40 $entry_cs_tumor delete 0 end 
$entry_cs_node delete 0 end 
$entry„cs_jmetastasis delete 0 end 
$entry_cs_note delete 0 end 

45 set ivw [ $image__canvas active get inview] 

set cod [$image_canvas active get code] 

set sym [$image_canvas active get symbol] 

set lbl [$image_canvas active get label] 

set cap [$image_canvas active get caption] 



50 



#puts ■ symbol = $3^" 
#puts ■ label = $lbl n 
#puts ■ caption = $cap" 



55 set cs_ class [$image_canvas active get cs_j class] 
set cs_tumor [$image__canvas active get cs_tumor] 
set cs_node [$image__canvas active get cs_node] 
set cs_jnetastasis [$image_canvas active get cs_metastasis] 
set cs_note [$image_canvas active get cs_note] 

60 

$entry_inview insert 0 $ivw 
$entry_code insert 0 $cod 
$entry_symbol insert 0 $sym 
$entry_label insert 0 $lbl 
55 $entry_caption insert 0.1 $cap 



$entry_cs_class insert 0 $cs_class 
$entry_ cs_tumor insert 0 $cs__ tumor 
$entry__cs_node insert 0 $cs_node 
70 $entry_ cs_metastasis insert 0 $cs_metastasis 
$ entry_cs_.no te insert 0 $cs_note 



75 proc iat: :app: :handle_ant_deselect { ns } { 
variable TRACE 

if {$TRACE> { puts -iat: :app: :handle_ant_deselect : $ns" } 

upvar #0 [join [list [namespace current] $ns image_canvas] ::] image_canvas 
30 upvar #0 [join [list [namespace current] $ns entry__inview] entry_inview 
upvar #0 [join [list [namespace current] $ns entry__code] ::] entry_code 
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10 



15 



upvar #0 [join [list [namespace current] $ns entry_symbol] ::] entry_symbol 

upvar #0 [join [list [namespace current] $ns entry_label] ::] entry_label 
upvar #0 [join [list [namespace current] $ns entry_caption] ::] entry_caption 



upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 



$ns entry_cs__class] : : 3 entry__cs_class 

$ns entry_cs_tumor) : : ] en t ry__c s_tumo r 

$ns entry_cs_node] : : 3 entry__cs_node 

$ns entry_cs_metastasis] entry_cs_jnetastasis 

$ns entry_cs_note] : : 3 entry_cs_^note 



set ivw [string trim 
set cod [string trim 
set sym [string trim 
set Ibl [string trim 
set cap [string trim [ $entry_caption get 0.1 end] ] 



[ $entry_inview get]] 
[ $ entry_code get ] ] 
[ $entry_symbol get]] 
[$entry__label get]] 



#puts ■ symbol = $sym* 
#puts M label = $lbl n 
#puts ■ caption = $cap" 

20 

set cs_class [string trim [$entry_cs_class get]] 
set cs_tumor [string trim [$entry_cs_tumor get]] 
set cs_node [string trim [$entry_csjiode get]] 
set cs_jmetastasis [string trim [ $entry_cs_metastasis get]] 
25 set cs_note [string trim [$entry_cs_jiote get]] 

if {$ivw != on } { $image_canvas active set inview $ivw } 

if {$cod != "■) { $image_canvas active set code $cod } 

if {$sym l« Wtt ) { $image_canvas active set symbol $sym } 

30 if {$lbl != nn ) { $image_canvas active set label $lbl } 

if {$cap != OB ) { $image__canvas active set caption $cap } 



if {$cs_class != ■"} { $image_canvas active set cs_class $cs_class } 

if {$cs_ tumor != ■ " } { $image_canvas active set cs_tumor $cs_tumor } 

35 if {$csjiode != BO > { $iraage__canvas active set cs_node $cs__node } 

if {$cs_jmetastasis ! = n ° } { $image_canvas active set csjnetastasis $cs_metastasis } 

if {$cs_note I = "■> { $image_canvas active set cs_note $cs_note } 



$entry_inview delete 0 end 
10 $entry_code delete 0 end 

$ en try_ symbol delete 0 end 
$entry_label delete 0 end 
$entry_caption delete 0.1 end 

15 $entry_cs_class delete 0 end 
$entry_cs__tumor delete 0 end 
$entry_cs_node delete 0 end 
$entry_ cs_jnetastasis delete 0 end 
$entry_cs_note delete 0 end 

>0 

edi t_update_view $ns $ivw 



) 



>5 proc iat : : app : : dialog^ groups { ns ] { 
variable DEMOl 



upvar #0 [join [list [namespace current] $ns image_url] ::] image_url 
upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image^canvas 

50 

variable DEMOl 
if {$DEM01} { 

tkjnessageBox -type ok -message "This option is not available in the IAT Technology Evaluation. " 
return 

>5 } 



set ants [$image_canvas cget -annotations] 
set rv [iat: : dialog : :dialog__edit_groups $ants] 

) 

'0 

proc iat : : app : : dialog_borders { ns } { 



upvar #0 [join [list [namespace current] $ns imagejurl] ::] image_url 
upvar #0 [join [list [namespace current] $ns iinage_canvas) : : ] image_canvas 

'5 

set borders [$image_canvas cget -borders] 
#puts "borders » $borders" 

set newborders [iat: : dialog : :dialog_edit_borders $borders] 
if {$newborders {}) { return } 
>Q $image_canvas configure -borders $newborders 

) 
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proc iat: :app: :app_splash { ns ) { 
variable TRACE 

if {$ TRACE) { puts "iat: :app: :app__splash: $ns" > 

iat: : dialog : :dialog__doc "MI AT Technology Evaluation" [iat: :var_str_splash] 

5 } 

proc iat: :app: :help_about { ns } { 
variable TRACE 

if ($TRACE) { puts "iat: :app: :help_about: $ns* } 

10 

variable version 
set str °" 

append str "Electronic Medical Education Resource Group <EMERG)\n" 
15 append str "Medical Image Annotation Tool (MI AT or IAT v$version) \n" 

append str ■ (c) 2001, 2002 University of Utah, SLC UT\n\n" 
append str ■ Contacts \n" 

append str "Director: patricia.goede@hsc.utah.edu\n" 
append str "Software: jason.lauman®hsc.utah.edu\n" 

20 

tJtLJnessageBox -title "About IAT v$version" -message $str 

> 



25 proc iat: :app: :help_todo { ns } { 
variable TRACE 

if {$TRACE} { puts "iat: :app: :help_todo: $ns" } 

iat :: dialog :: dialog_doc "IAT Documentation: To Do" [iat: :var_str„todo] 

) 

30 

proc iat : : app : : show_console { ns } { 
variable TRACE 

if { $ TRACE) { puts B iat : : app : : show_console : $ns ■ } 
console show 

35 > 

proc iat: :app: :dump_ants { ns ) { 
variable TRACE 

if {$ TRACE) { puts "iat: :app: :dump_ants: $ns" ) 
40 upvar #0 [join [list t namespace current] $ns image_canvas] ::) image^canvas 

$image_canvas dump annotations 0 

) 

proc iat: :app: :dump_svg { ns ) { 
4 5 variable TRACE 

if ($ TRACE) { puts " iat : : app : : dump^svg : $ns" ) 

upvar #0 [join [list [namespace current 3 $ns image_canvas) image_canvas 
$image„canvas dump svg 

) 

50 

proc iat: :app: :dump.Jceys { ns ) { 
variable TRACE 

if {$TRACE) { puts " iat : : app : : dump_Jceys : $ns u ) 

upvar #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 
55 $image_canvas dump keys 
) 

proc iat : : app : : debug_canvas { ) { 
variable imageCanvas 
60 $ imageCanvas dump 

) 

iat . canvas . txt 

# Copyright (c) 2001, University of Utah 

# All rights reserved. 
65 # 

# iat . canvas . tcl 

#package provide iat. canvas 0.2 

7 0 namespace eval iat : : canvas { 

variable TRACE 0 
variable id 0 

variable sizes [list 25 50 100 200 400] 
75 variable point [list 0 0] 

variable ptnum n " 
variable vertn ■ " 
variable ptrmode "single" 



30 ) 
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proc iat: : canvas : :proc { cname cmd args } { 
variable TRACE 

if {$TRACE> { puts "iat: : canvas :: proc: $cname $cmd $args } 



10 



upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 



$cname state] : : ] state 
$cname status_label] ::] status_label 



] callback^select 
: : ] callbackL_deselect 



upvar #0 [join [list [namespace current] $cname callbacK-S elect] : 

upvar #0 [join [list [namespace current] $cname callback^deselect] . ™— ™— — - 
upvar #0 [join [list [namespace current! $cname callbacK_deselect_server] ::] callback_deselect_server 

upvar #0 [join [list [namespace current] $cname annotations] ::) annotations 

# end create if call from app. . . 
if {$state == "CREATE" } { 

ant_create_end $ cname 0 0 

) 

switch $crad { 

"configure" [ 

foreach {key value) $args { 
switch — $key { 

"-file" { set_file $cname $value } 
"-image" { set_JLmage $ cname $value > 
"-scale" { set_scale $cname $value } 
"-borders" { set_borders $cname $value } 

"-status" { set status_label $value } 
"-select" { set_s elect _mode $cname $value ) 
"-callbackselect" { set callback^select $value } 
"-callbackdes elect" { set callback_deselect $value } 
"-callbackserver" { set callback_deselect_server $value } 



} 



} 



15 



15 



SO 



55 



50 



55 



70 



75 



"cget" { 

#puts "proc = cget: $args" 
switch — [1 index $args 0] { 

"-borders" { return [getjDorders $cname] ) 
"-annotations" { return $annotations } 
) 

begin" { 

$annotations begin [lindex $args 0] 

end" { 

# do nothing for now 

active" { 

set rv [$annotations $args] 

return $rv , 

> 

"annotations" { 

switch — [lindex $args 0] { 
"make" { 

# arg 2 is indent level 
ant_deselect $ cname 

set str [make_cmds $cname [lindex $args 2]] 

append str [$annotations make [lindex $args 1] [expr [lindex $args 2]]] 
return $str 

} 

"parse" { 

$annotations parse [lindex $args 1] 

) 

"readLcmds" { 

return [ant_read_cmds $cname [lindex $args 1]] 

} 

"paste" { 

click__reset $ cname 

$annotations parse [lindex $args 1] 

$anno tat ions draw all 

> 

} 

if {$state == "THUMB" } { 

click_reset_thumbnail $ cname 
} else { 

click_reset $ cname 

) 



80 



"borders" { 

set_borders $ cname $args 

> 

"close" { 



10 



15 



20 



>5 



30 



15 



10 



15 



>0 



>5 



WO 2004/057439 

return [close $cname] 
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) 



"create" { 

foreach {key value) $args { 
switch — [1 index $args 0] { 

"roi" { return [ tool_create_star t $cname $value] } 

"pointer" { return [ant_create__pointer_start $cnaroe $value] } 

"symbol" { return [ant_create_symbol $cname] } 

> 

) 

"delete" { 

switch — [lindex $args 0] { 
"symbol" { return [ant_delete_.symbol $cname] } 
"active" { return [ant_delete $cname] } 
) 



destroy" { 

return [widget^destroy $cname] 

image" { 

return [ant_jnake__image $cname) 

make_cmds " { 

return [ant_jnake_cmds $cname) 



move" { 



switch — [lindex $args 0] { 

"active" { return [ant_move $cname] } 



} 



"redraw" { 

return [redraw_image $cname] 

) 

"postscript" { 

return [ant_jmake_ps $cname [lindex $args 0] ) 

"pointer" { 

switch — [lindex $args 0] { 

"style" { return [ant_ptr_style $cname] } 
"pin" { return [ant__ptr„pin $cname] } 
"symbol" { return [ ant_ptr_symbol $cname] } 

> 

"svg" { 

return [ant_make_svg $cname] 

) 

"dump" { 

switch — [lindex $args 0] { 

"annotations" { return Cdump_annotations $cname] } 
"keys" { return [dump_keys $cname] ) 
"svg" { return (dump_svg $cname] > 

} 
) 

default { 
) 



> 



iO 



return 



>5 proc iat :: canvas :: create { path } { 
variable TRACE 

if ($TRACE) { puts " iat :: canvas ;: create : $path" > 
variable id 
variable sizes 

•o 

if {$path == ".»> { set path "" } 
set wid [incr id] 

set w [ScrolledWindow $path.w$wid -relief sunken -borderwidth 2] 
pack $w -side top -anchor nw -fill both -expand yes 
'5 set path $w 

set f [ScrollableFrame [$path getframe].f -areawidth 0 -areaheight 0] 
pack $f -side top -anchor nw -fill both -expand yes 
set path $f 



set c {canvas [$path getframe].c -width 2 -height 2 -borderwidth 2 -background gray] 
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$w setwidget $f 

pack $c -anchor nw -fill both -expand yes 

5 set ns [namespace current] : :canvas$wid 

namespace eval $ns { 
variable widget 

variable canvas 
variable state NONE 
10 variable select _mode annotation 

variable filename 

variable images 
variable image " ° 
variable annotations 
15 variable percent 100 

variable borderL 0.005 
variable borderT 0.005 
variable borderR 0.005 
variable borderB 0.005 
20 variable borderColor black 

variable status_label " " 
variable callback's elect "noop" 
variable callback_deselect "noop" 
25 variable callback_deselect_server "noop" 

foreach size $iat: : canvas sizes { set images ($size) } 

} 

30 upvar #0 [join [list $ns widget] ::] widget 

upvar #0 [join [list $ns canvas] ::] canvas 
upvar #0 [join [list $ns annotations] ::] annotations 

set widget $w 

35 set canvas $c . , 

set annotations [iat :: ant: : create -canvas $c -cmdcanvas [namespace current] :: canvas 9wi<a ] 
#puts " annotations = $anno tat ions" 

set wcmd "proc [namespace current] :: canvas $wid { cmd args } {eval [namespace current] : :proc 
40 canvas$wid \$cmd \$args} M 

namespace eval : : $wcmd 

# default behavior it to pan it . . . 

#bind $c <ButtonPress~l> "[namespace current] : .-tool Start Pan $f %W %x %y n 
45 #bind $c <Buttonl-Motion> "[namespace current] : :toolDoPan $f %W %x %y" 

return [namespace current] :: canvas $wid 

> 

50 proc iat :: canvas :: thumbnail { path > { 
variable TRACE 

if { $TRACE) { puts w iat :: canvas :: thumbnail: $path u } 
variable id 
variable sizes 



55 



if <$path « ".") { set path »• } 
set wid [incr id] 



set w [frame $path.w$wid] 
60 pack $w -side top -anchor nw -fill both -expand yes 
set path $w 



65 



set c [canvas $path,c -width 2 -height 2 -borderwidth 2 -background gray] 
pack $c -anchor nw -fill both -expand yes 

set 1 [label $path.l -text ""] 

pack $1 -anchor nw -fill x -expand yes 



set ns [namespace current] :: canvas $wid 
70 namespace eval $ns { 

variable widget 

variable canvas 

variable state NONE 

variable select_mode annotation 
75 variable filename 

variable images 

variable image w " 

variable annotations 

variable percent 100 
80 variable borderL 0.10 

variable borderT 0.10 
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variable borderR 0.10 
variable borderB 0.10 
variable borderColor red 



5 variable status_label ■ ■ 

variable callbacks elect *noop* 
variable callbacK_des elect "noop" 
variable callback_deselect_server "noop" 

0 foreach size $iat :: canvas :: sizes { set images ($ size) } 



upvar #0 [join [list $ns widget] : : ] widget 

upvar #0 [join [list $ns canvas] ::] canvas 

upvar #0 [join [list $ns state] ::1 state 

upvar #0 [join [list $ns status_label] ::] status_label 

upvar #0 [join [list $ns annotations] ::] annotations 

set widget $w 
set canvas $c 

set status_label $1 „ . , . 

set annotations [ iat :: ant :: create -canvas $c -cmdcanvas [namespace current) : :canvas$wid ] 
#puts tt annotations = $annotations° 

set wcmd "proc [namespace current] : :canvas$wid { crad args } {eval [namespace current] : :proc canvas$wid 
\$cmd \$args) M 

namespace eval : : $wcmd 

# default behavior it to pan it... 

#bind $c <ButtonPress-l> -[namespace current] :: toolStartPan $f %w %x *y 
#bind $c <Buttonl-Motion> "[namespace current ]:: toolDoPan $f %W %x %y n 

#click_reset_thumbnail canvas $wid 
set state THUMB 



15 



return [namespace current] :: canvas $wid 



proc iat: : canvas : :widget_des troy { ns } { 
10 variable TRACE 

if {$ TRACE) { puts ° iat :: canvas : :widget_des troy: $ns° } 
variable id 
variable sizes 

15 upvar #0 [join [list [namespace current] $ns widget] ::] widget 

pack forget $widget 
: : destroy $ widget 

} 

50 

proc iat :: canvas :: close { ns > { 
variable TRACE 

if { $TRACE > { puts ° iat : : canvas : : close : $ns " } 



35 variable sizes 

upvar #0 [join [list [namespace current] $ns canvas] ::) canvas 

upvar #0 [join [list [namespace current] $ns image) ::] image 

upvar #0 [join [list [namespace current] $ns images] ::] images 

60 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 



$annotations close 

foreach size $ sizes { 
65 if {$images($size) != ■■) { 

image delete $images ($size) 

) 

set images ($size) ■■ 

} 



70 



75 ) 



$canvas configure -background black 
$ canvas configure -width 2 
$canvas configure -height 2 



proc iat : : canvas : : dump { cname ) { 

upvar #0 [join [list [namespace current] $cname canvas] i 

upvar #0 [join [list [namespace current] $cname image] i: 

80 upvar #0 [join [list [namespace current] $cname images] 

upvar #0 [join [list [namespace current] $cname percent] 



: ] canvas 
] image 
: ] images 
: : ] percent 



WO 2004/057439 - 83 - 

Appendix 2 

puts "canvas - $canvas" 

puts "image « $ image" 

puts "images = [array get images]" 

puts "percent = $percent° 

5 } 

proc iat: : canvas : :noop { args } { 
variable trace 

if ($TRACE) { puts "NOOP: $args" > 

10 } 

proc iat: : canvas : :set_file { cname file > { 

upvar #0 [join [list [namespace current] $cname filename] ::] filename 

15 set filename $file 

set img [image create photo -file $file] 
set^image $cname $img 

) 

20 proc iat :: canvas : :set_select_mode { ns mode } { 
variable TRACE 

if {$ TRACE) { puts "iat: : canvas : : set_jselect__mode: $ns $mode n } 

upvar #0 [join [list [namespace current] $ns annotations) ::) annotations 
25 upvar #0 [join [list [namespace current) $ns selectjnode] ::] select_mode 

upvar #0 [join [list [namespace current) $ns state] ::] state 

set reselect 0 
set key active 
30 if {$state == "ANT" ) { 

set key [ $annotations get key] 

set reselect 1 

> 

35 click_reset $ns 

if {$mode « "edit") { 

set select_mode edit 
} else { 

40 set select_mode annotation 

) 

$annotations configure -select $mode 

if ($reselect) { 
45 ant_select $ns key$key 

) 

) 

50 proc iat :: canvas :: redraw_image { ns ) { 
variable TRACE 

if {$TRACE) { puts " iat :: canvas :: redraw_image : $ns" ) 

upvar #0 [join [list [namespace current) $ns state] ::) state 
55 upvar #0 [join [list [namespace current) $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns image) ::] image 
upvar #0 [join [list [namespace current] $ns images) ::] images 
upvar #0 [join [list [namespace current] $ns annotations] ::) annotations 
upvar #0 [join [list [namespace current] $ns border!,] ::] borderL 
60 upvar #0 [join [list [namespace current] $ns borderT] ::) borderT 

upvar #0 [join [list [namespace current] $ns borderR] ::] borderR 
upvar #0 [join [list [namespace current] $ns border B] ::] borderB 
upvar #0 [join [list [namespace current] $ns borderColor] : : ) borderColor 

65 set ix [image width $ image] 

set iy [image height $ image] 

# b = border 

set bL [expr round ($ix * $borderL) ) 
70 set bT [expr round ($iy * $borderT) ] 

set bR [expr round ($ix * $borderR) ] 
set bB [expr round ($iy * $borderB) ] 

click_reset $ns 
75 $annotations erase all 

$canvas delete image 
#$canvas delete border 



80 $canvas configure -background $borderColor 

$ canvas configure -width [expr $ix + ($bL + $bR) ] 



10 
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$canvas configure -height texpr $iy + ($bT + $bB) 3 

$canvas create image 0 0 -anchor nw -image $image -tags [list image] 
$canvas coords image $bL $bT 

$annotations configure -offset [list $bL $bT] -size [list $ix $iy) 
$annotations draw all 
#if {$state == "THUMB" ) [ clicK_reset_thumbnail $cname } 
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proc iat : : canvas : : get_borders { ns } { 
15 variable TRACE 

if { $TRACE } { puts ■ ia t : : canvas : : get ^border s : $ns " 



) 



20 



25 



upvar #0 [join [list [namespace current] $ns borderl*] 
upvar #0 [join [list [namespace current] $ns borderT] 
upvar #0 [join [list [namespace current] 



] borderL 
] borderT 
$ns borderR] : : ] borderR 



upvar #0 [join [list [namespace current] $ns borderB] ::] borderB 
upvar #0 [join [list [namespace current] $ns borderColor] ::] borderColor 

#set x : : canvas 

#set x [namespace current] :: $cname$x 

#set c [set $x] 

return [list $borderL $borderT $borderR $borderB $borderColor] 



30 



> 



proc iat :: canvas :: set Jborders { cname 1st } { 
variable TRACE 

if ($TRACE) ( puts ° iat :: canvas :: set_borders : $cname $lst tt } 

35 upvar #0 [join [list [namespace current] $cname borders) borderL 

upvar #0 [join [list [namespace current] $ cname borderT] ::] borderT 



40 



45 



50 



upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 
upvar #0 [join [list [namespace current] 

set x : : canvas 

set x [namespace current] : : $ cname $x 
set c [set $x] 

set border!, [lindex $lst 0] 
set borderT [lindex $lst 1] 
set borderR [lindex $lst 2] 
set borderB [lindex $lst 3] 
set borderColor [lindex $lst 4] 

redraw_image $cname 



$cname borderR] : : ] borderR 
$cname borderB] : : ] borderB 
$cname borderColor] : : ] borderColor 



} 



proc iat : : canvas : : set_iioage ( cname img ) { 
55 variable TRACE 

i f { $ TRACE } { puts * iat : : canvas : : se t__image : $cname $ img u } 
variable sizes 

upvar #0 [join [list [namespace current] $cname canvas] ::) canvas 
60 upvar #0 [join [list [namespace current) $cname state] ::] state 
upvar #0 [join [list [namespace current] $cname image] ::] image 

upvar #0 [join [list [namespace current] $cname images] ::) images 
upvar #0 [join [list [namespace current] $cname percent) ::] percent 

65 foreach size $sizes { 

if {$images($size> != nn ) { 

image delete $images ($size) 

) 



70 



set images ($size) 



75 



set image $img 

set images (100) $img 

# new image set to current scale ♦ . 
set__scaie $cname $percent 

click_reset $ cname 



80 



proc iat : : canvas : : set^scale { cname newp ) { 



10 



15 



20 



25 
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variable TRACE 

if {$TRACE> { puts "iat :: canvas : :set_scale: $cname $newp" } 

upvar #0 [join [list [namespace current] $cname canvas] ::] canvas 

upvar #0 [join [list [namespace current] $cname image] ::J image 

upvar #0 [join [list [namespace current] $cname images] ::] images 

upvar #0 [join [list [namespace current] $cname percent] ::] percent 

set percent $newp 

if {$images ($percent) == ■ ■ ) { 

set srclmg $images(100) 

set newlmg [image create photo] 

if {$percent == 100} { 

# copy 

$newlmg copy $srclmg 
) elseif {$percent > 100} { 

# zoom 

set n [expr round ($percent/ 100) 3 
$newlmg copy $ srclmg -zoom $n 
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} else { 



# subsample 

set n [expr round { 10 0 / $percent ) ] 
$newlmg copy $ srclmg -subsample $n 



-shrink 



} 

set images ($percent) $newlmg 



30 } 



set image $ images ($per cent) 
redraw_image $cname 



35 



40 



proc iat : ; canvas : : ant_deselect { cname } { 
variable TRACE 

if { $TRACE } { puts ■ iat : : canvas : : ant_deselect : $cname " 



} 



upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 



[join 
[join 
[join 
[join 



[list 
[list 
[list 
[list 



[join [list 



[namespace current] 
[namespace current] 
[namespace current} 
[namespace current] 
[namespace current] 



$cname canvas ] : : ] canvas 

$cname image 3 : : ] image 

$cname annotations ] : : ] annotations 

$cname state] : : 3 state 

$cname callback^deselect} : : ] callbacK_deselect 



$ canvas dtag SELECTED 



as 



eval $callback w _deselect 
$anno tat ions save 



$annotations deselect 



30 



> 

proc iat: : canvas : :click_reset_thumbnail { cname } { 
variable TRACE 

if { $ TRACE} { puts d iat : : canvas : : clicker eset_thumbnail : 



$ cname" } 



35 



30 



upvar #0 [join [list [namespace current] $cname canvas] ::] canvas 



upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 [join [list [namespace current] 

upvar #0 (join [list [namespace current] 



$ cname image] ::] image 

$cname state] ::] state 

$cname status_label] : : ] status__label 

$cname filename] : : ] filename 

$cname callbacks-select] ::] callbacX_select 



#ant_deselect $ cname 

bind $canvas <Button-l> $callback w select 
55 bind $canvas <Buttonl-Motion> {iat :: canvas : ;noop thumbnail %x %y} 

bind $canvas <Double-Button-l> "iat : : canvas: :noop thumbnail %x %y tt 

bind $canvas <ButtonRelease-l> n iat :: canvas :: noop thumbnail %x %y" 

$canvas bind image <Double-Button-l> $callback v _select 

$canvas bind ant <Button-l> $callback^_select 
10 # will need pointer and label here as well . . . 

if ($status_label 1= ■■) { $status_label configure -text [file tail [file rootname $f ilename] 3 } 



'5 ) 



set state THUMB 



iO 



proc iat: : canvas :: clicker eset_server { cname ) { 
variable TRACE 

if ($TRACE) { puts "iat: : canvas : :click_reset_server: $cname° } 

upvar #0 (join [list [namespace current] $cname callback_deselect_server} ::] callback_deselect_server 
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click^reset $cname 

eval $callback_deselect_server 

> 

5 

proc iat: : canvas : :click_reset { cname } { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas : :click_reset: $cname" } 

L0 upvar #0 [join Hist [namespace current] $ cname canvas] ::] canvas 

upvar #0 [join [list [namespace current] $cname image] ::] image 
upvar #0 [join [list [namespace current) $cname state) ::) state 
upvar #0 [join [list [namespace current] $cname status_label] ::] status_label 

L5 if {$state == "THUMB" ) { click_reset_thumbnail $cname; return } 

ant_deselect $ cname 

bind $canvas <Button-l> { iat :: canvas :: noop click^reset %x %y) 

10 bind $canvas <Buttonl-Motion> {iat canvas :: noop click^reset %x %y) 

bind $canvas <Double-Button-l> "iat :: canvas : :click_reset„server $cname" 
bind $canvas <ButtonRelease-l> " iat: -.canvas: : noop clickjeset Bl -Release $cname %x %y* 
•$canvas bind image <Double -Button- 1> "iat :: canvas : iclick^reset^server $cname" 
$canvas bind ant <Button-l> "iat: : canvas : :click_ant $cname %x %y" 

25 # will need pointer and label here as well... 

if {$status_label !- ■ ■ } { $status_label configure -text "Ready." > 
set state READY 

30 ) 

proc iat: : canvas : :click_ant { ns x y ) { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas : :clicK_ant: $ns $x $y° ) 
variable point 

upvar #0 [join [list [namespace current) $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns state] ::] state 

40 #bind $canvas <Button-l> () 

#bind $canvas <Double-Button-l> "iat: : canvas : :click_reset $ns" 
#$canvas bind handle <Button-l> "iat: .-canvas; : clicKJiandle $ns %x %y" 



35 



45 



set point [list $x $y] 



if {$state == "CREATE") { 

ant_create__vertex $ns $x $y 
) elseif {$state == "MOVE") { 
# don 1 t deselect . . . 
50 ) else { 

ant_deselect $ns 
ant__select_at $ns $x $y 
#puts ■ HERE! I I ■ 

#bind $canvas <Double-Button-l> "iat : : canvas :: noop ant_click_reset $cname" 
55 #$canvas bind image <Double-Button-l> ° iat :; canvas : :noop ant_click_reset $cname" 

) 



#bind $canvas <Buttonl-Motion> ■ iat :: canvas :: ant_drag_ant $ns %x %y" 



60 ) 



65 



proc iat : : canvas : s click^handle { ns x y ) { 
variable TRACE 

if <$TRACE) { puts "iat: : canvas : :click_handle: $ns $x $y" ) 

variable point 
variable ptnum 

variable vertn 

70 upvar #0 [join [list [namespace current] $ns canvas] ::) canvas 

upvar #0 [join [list [namespace current] $ns annotations] annotations 
upvar #0 [join {list (namespace current) $ns state] ::] state 

switch $state { 
75 "READY" { 

#puts "ClickHandle: do nothing (no polygon selected)" 

) 

"ANT" { 

#puts "ClickHandle: select handle" 



80 



# vertex is in a different polygon 
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#set point [isPointlnPointa $x $y $points] 

#if ($point < 0} { 

# sector is in a different polygon 

#set point [ isPointlnPoints $x $y $ sectors] 
5 #if {$point < 0} { return ) 

#} 

set point [list $x $yj 
$canvas addtag HANDLE closest $x $y 3 
10 $canvas itemconf igure HANDLE -fill red -outline black 

set tags [$canvas gettags HANDLE] 
set type "none" 

if {(lsearch $tags vertex] > -1} { set type vertex } 
15 if {[lsearch $tags sector] > -1} { set type sector } 

if {[lsearch $tags symbol] > -1) { set type symbol } 
if {[lsearch $tags tail] > -1} { set type tail } 
if {[lsearch $tags head] > -1} { set type head ) 
if {[lsearch $tags ptrvert] > -1} { 
20 set type ptrvert 

set vidx [lsearch -regexp $tags {vx(\d+))] 
set tag [1 index $tags $vidx] 
regexp {vx(\d+)) $tag m vertn 

} 

25 if {[lsearch $tags ptrsect] > -1} { 

set type ptrsect 

set vidx [lsearch -regexp $tags {sx(\d+)}] 
set tag [lindex $tags $vidx] 
regexp {sx<\d+)> $tag m vertn 

30 } 

if {$type as "none") { error "Handle is not a head, tail, vertex, sector or symbol I " } 

set nidx [lsearch -regexp $tags {num(\d+))3 
set tag [lindex $tags $nidx] 
35 regexp {num<\d+J} $tag m ptnum 

#puts " ptnum « $ptnum B 

set state NONE 

I 0 # have to bind things that are __not_ the handle . . . 

$ canvas bind border <Button-l> °iat: .-canvas: : an t_move__$type $ns %x %y° 
$canvas bind image <Button-l> n iat :: canvas : :ant_move_$ type $ns %x %y M 
$canvas bind ant <Button-l> °iat :: canvas : :ant_move_$ type $ns %x %y° 
$canvas bind segment <Button-l> B iat : .-canvas: : an t_move_$ type $ns %x %y n 

15 bind $canvas <Buttonl-Motion> B iat :: canvas :: an t_drag_$ type $ns %x %y" 

#puts ■ HERE! 1° ' 

bind $canvas <Double-Button-l> B iat; .-canvas : :noop click_reset $ns" 

set state [string toupper $type] 
50 ) 
"VERTEX" { 

$canvas addtag DELHANDLE closest $x $y 3 
set tags [$canvas gettags DELHANDLE] 
$ canvas dtag DELHANDLE 
»5 set nidx [lsearch -regexp $tags {num(\d+))3 

set tag [lindex $tags $nidx) 
regexp {num(\d+)} $tag m tmpnum 
#puts B ptnum = $ptnum" 

#puts n tmpnum = $ tmpnum 0 
»0 if {$ tmpnum == $ptnum> { 

ant_delete_vertex $ns $x $y 

} 

} 

n SECTOR" { 

■5 ant_insert_vertex $ns $x $y 

) 

■ HEAD___o Id " ( 

# moving the head is handled through the pointer tail now. . . 
$ canvas addtag DELHANDLE closest $x $y 3 
0 set tags [$canvas gettags DELHANDLE] 

$ canvas dtag DELHANDLE 

set nidx [lsearch -regexp $tags {num(\d+)>] 
set tag [lindex $tags $nidx] 
regexp {num<\d+)> $tag m tmpnum 

5 

$anno tat ions move head $ tmpnum auto 
ant_select $ns active 



0 



} 

"TAIL" { 

$canvas addtag DELHANDLE closest $x $y 3 
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set tags [$canvas gettags DELHANDLE] 
$canvas dtag DELHANDLB 

set nidx (lsearch -regexp $tags {num(\d+))3 
set tag [lindex $tags $nidx] 
5 regexp {num(\d+)) $tag m tmpnum 

$annotations delete pointer $tmpnum 
ant_j3elect $ns active 

L0 > 

"PTRVERT* { 

$canvas addtag DELHANDLB closest $x $y 3 

set tags C$canvas gettags DELHANDLE] 

$ canvas dtag DELHANDLE 
L5 set nidx [lsearch -regexp $tags {vx(\d+>}] 

set tag [lindex $tags $nidx] 

regexp {vx(\d+)} $tag m tmpn 

if {$tmpn == $vertn) { 

ant_delete_ptrvert $ns $ptnum $vertn 
>0 ant_select $ns active 

} 

) 

"PTRSECT" { 

ant_insert_ptrvert $ns $x $y 

>5 ) 

"SYMBOL" { 

#roiSymbolMove $x $y 

) 

default { 

10 iat: : canvas : :noop click_handle $x $y 

} 

> 

) 

35 proc iat ;: canvas :: toolStartPan { w c x y > { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas :: tool Start Pan: $w $c $x $y" > 
variable panX 
variable panY 
10 variable panSX 
variable panSY 

set panX $x 
set panY $y 

set xv [$w xview] 

set xd [expr [lindex $xv 1] - [lindex $xv 0]] 
set panSX [expr $xd / 10] 

50 set yv [$w yview] 

set yd [expr [lindex $yv 1] - [lindex $yv 03 3 
set panSY [expr $yd / 10] 

) 

55 proc iat :: canvas :: toolDoPan { w c x y ) { 
variable TRACE 

if { $TRACE } { puts "iat: : canvas : :toolDoPan: $w $c $x $y" } 
variable panX 
variable panY 
50 variable panSX 
variable panSY 

set dx [expr $panx ~ $x3 
set dy [expr $panY - $y] 

65 

if {$dx > 10} {$w xview moveto [expr [lindex [$w xviewj 0] + $panSX] 

} elseif {$dx < 10} {$w xview moveto [expr [lindex [$w xview] 0 3 - $panSX] } 

if ($dy > 10} {$w yview moveto [expr [lindex [$w yview] 0] + $panSY] 
70 ) elseif {$dy < 10} {$w yview moveto [expr [lindex [$w yview] 0] - $panSY] } 

} 

proc iat: : canvas : :tool_create_s tart { cname kind } { 
75 variable TRACE 

if { $TRACE} { puts * iat :: canvas :: tool_start_create__ant : $kind" } 

upvar #0 [join [list [namespace current] $ cname canvas] ::] canvas 

upvar #0 [join [list t namespace current] $cname image] ::] image 

BO upvar #0 [join [list [namespace current] $cname annotations] ::] annotations 

upvar #0 [join [list [namespace current] $cname state] ::] state 
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upvar #0 [join [list [namespace current] $cname status_label] ::] status_label 

if {$state == "CREATE" } { 

ant__create_end $cname 0 0 

5 ) 

clicX__reset $cname 

bind $canvas <Button-l> "iat: : canvas : :ant_create__vertex $cname ***y a 
n bind $canvas <Double-l> ■ iat :: canvas :: ant_create_end $cname %x %y 

° $c^nvas^Ind ant <Button-l> "iat: : canvas : : noop too l_cr eat e_s tart Button-! $cname %x %y" 

$annotations create roi $kind 
set state CREATE 

switch SkincM { $status _ lafael configure _ text -click 1 or more points. Double-click for last point 
and end create. - jt^ { $status _ label configure -text -Click 2 or more points to create edge. Double-click 
:0 for last point a^end ^^J^ configure _ text -click 3 or more points to create area. Double-click 

for last point and end create . " } 
"circle" { } 

"rectangle" { } « \ 

:5 default { $status_label configure -text "Unknown create kind... > 

} 

#if {$kind == "group" > { 
JO # roiCreateEnd 0 0 

#} else { 
# set inCreate 1 
#} 

} 

B5 _ . 

proc iat s : canvas : : ant_create_end { cname x y } I 

variable TRACE a * * ■ i 

if {$ TRACE} { puts " iat :: canvas : : ant_create_end : §x sy t 



10 



45 



50 



upvar #0 [join [list [namespace current] $cname canvas] ::] canvas 

upvar #0 [join [list [namespace current] $cname image] ::] image 

upvar #0 [join [list [namespace current] $cname annotations] .:] annotations 

upvar #0 [join [list [namespace current] $cname state] ::] ^ate 

upvar #0 [join [list [namespace current] $cname status_label] ::] status_labei 

bind $canvas <Button-l> {} 

bind $canvas <Double-Button-l> {} 

$canvas bind ant <Button-l> {) 

# NOTE: Don't use click^reset because is deselects wbich saves annotation... 



# don't allow polygons with less than 3 points... 
set npts 0 

switch [$annotations kind active] { 
55 "group" { set npts 0 } 

"point" { set npts 1 } 

"edge" { set npts 2 } 

"area" { set npts 3 ) 

"rectangle" { set npts 2 } 
60 "circle" { set npts 2 } 

if {[llength [$annotations points active]] < $npts} ( 
$ canvas delete handle 
$annotations delete active 
65 set state NONE 

return 

# post-process points if creating rectangle or circle... 
if {[$annotations kind] == "rectangle"} { 
70 if {[llength [$annotations points active]] !- 2} { 

$canvas delete handle 

$annotations delete active 

set choice [tkjmessageBox \ 

^ess^Hec^angirmusr^specified witb top-left and bottom-right points." X 

-icon warning \ 
-type ok ] 

return 
} 

8 0 roiCreateEndRectangle 

> elseif { [$annotations kind] == "circle"} < 
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if {[llength t $annotations points active] 3 != 2) { 

$ canvas delete handle 

$annotations delete active 

iat : : roi : : roiDelete 

set choice [tk_messageBox \ 

-title "Circle Problem" \ 

-message "Circle must he specified with center and radius points." \ 
-icon warning \ 
-type ok ] 

return 
> 

roiCreateEndCircle 



> 



# without state reset infinite loop occurs, 
set state "ANT" 

$annotations save 

#$anno tat ions draw active 
#click_reset $cname 
ant_select $cname active 



} 



proc iat : : canvas : : ant_create_vertex { cname x y ) { 
5 variable TRACE 

if {$TRACE} { puts "iat: : canvas : : ant_create_ver tex : $x $y" } 

upvar #0 [join [list [namespace current] $cname canvas] ::) canvas 

upvar #0 [join [list [namespace current] $cname image] ::] image 

.0 upvar #0 [join [list [namespace current] $cname annotations] ::] annotations 

upvar #0 [join [list [namespace current] $cname state] ::] state 

$annotations create vertex [list $x $y] 
$anno tat ions erase active 
,5 $annotations draw segments 

$annotations draw vertexs 

) 

: 0 proc iat: : canvas an t_create_pointer_s tart { ns num } { 
variable TRACE 

if {$TRACE} ( puts " iat :: canvas :: ant_create_pointer : $ns $num" } 

variable head 
15 variable ptrmode 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current] $ns state] ::] state 



if {$state != "ANT" ) { return } 



set ptrmode single 

if {$num == "multiple") { set ptrmode multiple ) 
>5 set head auto 

bind $canvas <Double-l> "iat: : canvas : : clicks-reset $ns %x %y n 
bind $canvas <Button-l> "iat :: canvas : :ant_create_pointer_tail $ns %x %y" 
$canvas bind handle <Button-l> " iat :: canvas :: ant_create^ointer_head $ns %x %y" 



50 
> 

proc iat: : canvas :: an t_create_jpointer_tail { ns x y } { 
variable TRACE 

55 if ($TRACE) { puts "iat: : canvas : :ant_create_pointer_tail : $ns $x $y" > 

variable head 
variable ptrmode 

7 0 upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current] $ns state] ::] state 

# fix... if head and x,y are same then handle was clicked... 
75 if {[lindex $head 0] "head") { set head [lindex $head 1]; return } 

$annotations create pointer $head [list $x $y] {> 

if {$ptrmode -= "multiple") { 
30 bind $canvas <Double-l> "iat :: canvas : : click^_reset $ns %x %y" 

bind $canvas <Button-l> "iat :: canvas : : ant_create_pointer_J:ail $ns %x %y" 
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$canvas bind handle <Button-l> * iat :; canvas :: ant_create_pointer_head $ns %x %y" 

) else { 

bind $canvas <Double-l> ■ iat :: canvas :: click_reset $ns %x %y B 

bind $canvas <Button-l> "iat: : canvas : :noop pointer_tail $ns %x %y - 

5 

> 

ant_select $ns active 

10 > 

proc iat : : canvas : : ant_create_pointer_Jiead { ns x y } ( 
variable TRACE 

if { $TRACE } { puts "iat: : canvas : :ant_create_pointer.Jiead: $ns $x $y" ) 

15 

variable head 

upvar #0 I join tlist (namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
20 upvar #0 [join [list [namespace current] $ns state] state 

$canvas addtag DELHANDLE closest $x $y 3 
set tags [$ canvas get tags DELHANDLE] 
$canvas dtag DELHANDLE 
25 set nidx [lsearch -regexp $tags {nura{\d+))3 

set tag [lindex $tags $nidx] 
regexp {num{\d+)} $tag m tmpnum 

set head [list head $ tmpnum] 

30 

) 

proc iat : : canvas : t ant_ptr_symbol { ns } { 
variable TRACE 

35 if { $ TRACE } { puts • iat :: canvas : :ant_ptr_symbol : $ns» } 

variable head ^ 
variable ptnum 

40 upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 



45 if {$state == "TAIL* } { 

#puts ■ state == TAIL" 

$annotations pointer symbol $ptnum toggle 
} else { 

# do nothing. . . clicK_resetl 

50 ) 

click^reset $ns 
ant_select $ns active 

55 ) 

proc iat: : canvas : :ant_ptr_style { ns } { 
variable TRACE 

if ( $ TRACE} { puts "iat: : canvas : :ant_ptr_style: $ns" } 

50 

variable head 
variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
55 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 (join [list [namespace current] $ns state] ::] state 



if <$state « "TAIL" } { 
70 #puts u state == TAIL" 

$anno tat ions pointer style $ptnum toggle 
) else { 

# do nothing... clicKjreset I 

} 

75 

click_reset $ns 
ant_select $ns active 

) 

30 

proc iat : : canvas : : ant_ptr_pin { ns } { 
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variable TRACE 

if { $TRACE } { puts • iat : : canvas : : ant_ptr_pin : $ns ■ ) 

variable head 
5 variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

L0 

if {$state == -TAIL") { 

#puts ■ state == TAIL" 
$ annotations pointer pin $ptnum toggle 
L5 ) else { 

# do nothing... clicK_reset! 

) 

clicK_reset $ns 
20 ant_select $ns active 

> 

proc iat : : canvas : : ant_select { ns tag } { 
>5 variable TRACE 

if {$TRACE> { puts "iat: : canvas : :ant_select: $ns $tag" } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current) $ns annotations] ::] annotations 

30 upvar #0 [join [list [namespace current] $ns select_mode] ::] select_mode 

upvar #0 [join [list [namespace current) $ns state] ::] state 

upvar #0 [join [list [namespace current] $ns callbacks-select] ::] callbacks elect 

set key active 
$5 if {$tag == "active"} { 

set key [$annotations get key] 

} else { 

set tags [$ canvas get tags $tag] 
#puts "tags of $tag - $tags a 
10 set keyidx [lsearch -regexp $tags {key(\d+)>] 

if {$keyidx < 0} { puts "ERROR: ant_select: $tags«; return ) 

set tag [lindex $tags $keyidx] 

regexp {key(\d+) } $tag m key 

$ canvas addtag SELECTED withtag $tag 

15 ) 

# If there are no canvas tags then it is a non-visual annotation (group) 

$canvas bind border <Button-l> "iat :: canvas : :noop ant_ select border $ns %x %y" 
>0 $canvas bind image <Button-l> "iat: : canvas : :noop ant_select image $ns %x %y" 

$canvas bind ant <Button-l> a iat :: canvas :: noop ant_select ant $ns %x %y" 
$canvas bind segment <Button-l> w iat :: canvas : :click__ant $ns %x %y" 
if ($select_mode == "edit") { 

$canvas bind handle <Button-l> ■ iat :: canvas :: cliclOiandle $ns %x %y 
>5 #bind $canvas <Buttonl-Motion> " iat :: canvas :: noop ant_select Bl -Motions $ns %x %y" 

#bind $canvas <ButtonRelease-l> "iat: : canvas :; noop ant_select Bl-Release $ns %x %y" 
} else { 

$canvas bind handle <Button-l> " iat :: canvas :: noop ant_select Bl" 
$canvas bind head <Button-l> "iat : .-canvas: : click^handle $ns %x %y" 
>0 $canvas bind tail <Button-l> "iat :: canvas : : click_handle $ns %x %y° 

#$canvas bind segment <Buttonl-Motion> "iat: : canvas :: an t_drag_ant $ns %x %y" 
#bind $canvas <Buttonl-Motion> "iat: : canvas :: an t — drag_ant $ns %x %y" 

) 

# Test not binding double click here . . . 
!5 #bind $canvas <Double-Button-l> "iat : .-canvas: :click_reset $ns" 

$annotations select $key 
#puts ■ SELECTED: $key" 

0 # callback 

eval $callback_select 

set state "ANT" 

) 

5 

proc iat: : canvas :: an t_select_ at { ns x y } { 
variable TRACE 

if {$TRACE} { puts " iat :: canvas :: an t_select_at : $ns $x $y" } 



0 



variable point 
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upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] j:] annotations 

set point [list $x $y] 

$ canvas delete SELECTED 

$canvas addtag SELECTED closest $x $y 

ant_select $ns SELECTED 



> 



10 proc iat canvas :: ant_delete { ns } { 
variable TRACE 

if {$ TRACE) { puts -iat: : canvas : :ant_delete: $ns» } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
15 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

if {$state != "ANT") { return } 
set key [$anno tat ions get key] 
20 #puts * DELETING: $key M 

ant_deselect $ns 
$annotations erase $key 
$annotations delete annotation $key 
click_reset $ns 



25 } 



30 



proc iat t : canvas : : ant_delete_vertex { ns x y ) { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas :: an t_delete_vertex: $ns $x $y° > 

variable point 
variable ptnum 



upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
35 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 



$annotations delete vertex $ptnum 
ant_select $ns active 



40 > 



45 



proc iat : : canvas : : ant .jmove { ns > { 
variable TRACE 

if { $TRACE } { puts n iat :: canvas : :ant_move: $ns" ) 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns state] ::] state 



50 



if {$state != -ANT") { return ) 
set state MOVE 

bind $canvas <Buttonl-Motion> 0 iat :: canvas :: ant_drag_ant $ns %x %y B 

) 

55 

proc iat : : canvas : : ant_drag__ant { ns x y } { 
variable TRACE 

if {$TRACE) { puts ° iat :: canvas :: ant_drag_ant : $ns $x $y° } 

50 variable point 

upvar #0 [join [list [namespace current] $ns canvas] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

55 

if {$state -= "MOVE") { 
set state DRAG 

bind $canvas <ButtonRelease-l> ■ iat :: canvas ant_drag_ant_end $ns %x %y° 

) 

70 if {$state 1= "DRAG" > { return ) 

set dx [expr $x - [lindex $point 0]] 
set dy [expr $y - [lindex $point 1] ] 
$annotations move delta [list $dx $dy] 
'5 set point [list $x $y] 

# This does not change canvas bindings . . . 
$annotations select active 

> 

10 

proc iat : : canvas : : ant_drag_ant_ en d { ns x y } { 
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variable TRACE 

if {$ TRACE} { puts "iat: : canvas : :ant_o^rag_ant_end: $ns Sx 5y } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

bind $canvas <Buttonl-Motion> - iat :: canvas :: noop ant_drag_ant_end $ns %x %y 

$annotations select active 

set state "ANT" 

#ant_move_vertex $ns $x $y 



) 



proc iat: : canvas : :ant_drag_vertex { ns x y ) { 
variable TRACE 

.5 if {$ TRACE} { puts » iat :: canvas : :ant_drag_vertex: $ns $x $y" } 

variable point 
variable ptnum 

'0 upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current] $ns state] ::] state 

if {$state == "VERTEX"} { 
:5 bind S $canvas <ButtonRelease-l> « iat canvas :: ant^drag^vertex^end $ns %x %y" 

if {$state "DRAG"} { return } 

JO $annotations move vertex $ptnum [list $x $y] 
# This does not change canvas bindings ... 
$annotations select active 

} 

35 , f 

proc iat: : canvas : : ant_drag_vertex_end { ns x y } I 
variable TRACE 

if { $TRACE } { puts "iat: : canvas : : ant_drag_ver tex_end : $ns $x ?y ) 
upvar #0 [join [list [namespace current] $ns state] ::} state 
40 set state "VERTEX" 

ant_move_vertex $ns $x $y 

} 

proc iat : : canvas : : ant_move_vertex { ns x y } { 
45 variable TRACE 

if {$TRACE} { puts "iat: : canvas : :ant_jnove_vertex: $ns $x Sy } 



50 



variable point 
variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current] $ns state] ::] state 

55 if {$state 1= "VERTEX" } { return } 

click_reset $ns 

$annotations move vertex $ptnum [list $x $y] 
ant_select $ns active 

60 

} 

proc iat: : canvas :: an t_drag_sec tor { ns x y } { 
ant_insert_vertex $ns $x $y 
65 cliclOiandle $ns $x $y 

) 

proc iat: : canvas :: an t__move_sec tor { ns x y } { 
ant_insert_vertex $ns $x $y 

70 } 

proc iat: : canvas : : ant_insert_ver tex { ns x y } { 
variable TRACE 

if {$ TRACE} { puts "iat: : canvas : :ant_insert_vertex: $ns $x ?y > 

variable point 
variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current] $ns state] ::] state 



75 



80 
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if {$state != "SECTOR" } { return } 

$anno tat ions insert vertex $ptnum [list $x $y] 
ant_select $ns active 

5 

} 

proc iat: : canvas : :ant_drag_tail { ns x y } { 
variable TRACE 

L0 if {$TRACE) { puts "iat: : canvas :: an t_drag_tail: $ns $x $y" } 

variable point 
variable ptnum 

L5 upvar #0 [join [list [namespace current] $ns canvas] ::) canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current) $ns state] ::] state 

if {$state == "TAIL") { 
>0 set state DRAG 

bind $canvas <ButtonRelease-l> "iat: : canvas : : ant_drag_tail_end $ns %x %y" 

) 

if {$state 1= "DRAG" > { return } 

15 $anno tat ions move tail $ptnum [list $x $y] 

# This does not change canvas bindings . . . 
set rv [ $annotations select active) 
#puts ■ ptnum = $ptnum, rv = $rv" 
if ($rv >= 0} { set ptnum $rv } 

30 

> 

proc iat: : canvas :: an t_drag_tail__end { ns x y } { 
variable TRACE 

*5 if ($TRACE) { puts "iat: : canvas : :ant_drag_tail_end: $ns $x $y" } 

upvar #0 [join [list [namespace current] $ns state] ::] state 
set state "TAIL" 
antlmove_tail $ns $x $y 

} 

10 

proc iat: : canvas :: an t_move_tail { ns x y } { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas : :ant_move_tail : $ns $x $y" } 

15 variable point 

variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas) ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
>0 upvar #0 [join [list [namespace current] $ns state] ::] state 

if {$state != "TAIL") { return } 

click_reset $ns 
>5 $annotations move tail $ptnum [list $x $y) 

ant_select $ns active 

) 

>0 proc iat: : canvas :: an t_drag_head { ns x y ) { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas : :ant_drag Jiead: $ns $x $y" } 

variable point 
>5 variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
upvar #0 [join [list [namespace current) $ns state] ::) state 



0 



if {$state == "HEAD") { 
set state DRAG 

bind $canvas <ButtonRelease-l> " iat :: canvas :: an t_drag.JieadL.end $ns %x %y" 

) 

if {$state 1= "DRAG") { return ) 

set rv [$anno tat ions move head $ptnum [list $x $y] ] 

# This does not change canvas bindings . . . 
$annotations select active 

# puts " ptnum = $ptnum, rv = $rv" 
if {$rv >= 0) ( set ptnum $rv ) 
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> 

proc iat : : canvas : : ant_drag_heacL_end { ns x y > { 
variable TRACE 

if {$TRACE} { puts "iat: : canvas : : ant_drag_fcead_end : $ns $x $y" } 
5 upvar #0 [join [list [namespace current] $ns state] ::] state 

set state "HEAD" 
ant_move.Jiead $ns $x $y 

} 

10 proc iat :: canvas :: ant_move_head { ns x y } { 
variable TRACE 

if {$ TRACE} ( puts "iat: : canvas :: ant _jmove_Jiead: $ns $x $y" } 

variable point 
15 variable ptnum 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

20 

if {$state 1= "HEAD") { return > 
click_reset $ns 

$annotations move head $ptnum [list $x $y] 
25 ant_select $ns active 

> 



30 proc iat: : canvas : :ant_drag_ptrvert { ns x y ) { 
variable TRACE 

if ($TRACE) { puts " iat :: canvas :: ant — drag_ptrvert : $ns $x $y w } 



variable point 
35 variable ptnum 

variable vertn 



upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
10 upvar #0 [join [list [namespace current] $ns state] ::] state 

if {$state == "PTRVERT" } { 
set state DRAG 

bind $canvas <ButtonRelease-l> ■ iat :; canvas :: ant_drag_ptrvert_end $ns %x %y B 

15 ) 

if {$state != "DRAG"} { return } 

$annotations move ptrvert $ptnum $vertn [list $x $y] 
# This does not change canvas bindings . . . 
SO $annotations select active 



proc iat: : canvas ; :ant_drag_ptrvert_end { ns x y } { 
>5 variable TRACE 

if ($TRACE) { puts "iat: : canvas : :ant_drag_ptrvert_end: $ns $x $y» } 

upvar #0 [join [list [namespace current] $ns state] ::] state 
set state "PTRVERT" 
>0 ant_move_ptrvert $ns $x $y 

) 

proc iat; : canvas :: ant jnove_j?trvert { ns x y } { 
variable TRACE 

55 if {$TRACE> { puts "iat: : canvas :: an t_move_ptrvert : $ns $x $y" } 



variable point 
variable ptnum 
variable vertn 

'0 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

'5 if {$state 1= "PTRVERT" } { return ) 



click^reset $ns 

$annotations move ptrvert $ptnum $vertn [list $x $y] 
an t_s elect $ns active 

:0 

> 
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proc iat : : canvas : : ant__drag_ptrsect { ns x y } { 
variable TRACE 

if {$TRACE} { puts "iat: j canvas :: an t_drag_ptrvert: $ns $x $y" } 

5 ant_insert_ptrvert $ns $x $y 

click_handle $ns $x $y 

) 

proc iat: : canvas :: an t_move_ptr sect { ns x y > { 
10 variable TRACE 

if {$TRACE> { puts ■ iat :: canvas :: ant_move_ptrvert : $ns $x $y" } 
ant_insert_ptrvert $ns $x $y 

) 

15 proc iat :: canvas :: an t_insert_ptrvert { ns x y } { 
variable TRACE 

if {$TRACE> { puts "iat: : canvas : : ant_inser t_ptrvert : $ns $x $y" ) 

variable point 
20 variable ptnum 

variable vertn 

upvar #0 Cjoin [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 
25 upvar #0 [join [list [namespace current] $ns state] ::] state 

if {$state 1* "PTRSECT") { return } 

$annotations insert ptrvert $ptnum $vertn [list $x $y] 
30 ant_select $ns active 

) 

proc iat : : canvas : : ant_delete_ptrver t [ ns ptnum vertn > { 
35 variable TRACE 

if ($TRACE) { puts "iat: .-canvas: :ant_delete_ptrvert: $ns $ptnum $vertn" } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 Cjoin [list [namespace current] $ns annotations] ::] annotations 

40 

$annotations delete ptrvert $ptnum $vertn 
ant_select $ns active 

) 

45 

proc iat : z canvas :: an t_lower { ns } { 
variable TRACE 

if { $TRACE } { puts " ia t : : canvas : : an t_l ower : $ns 0 } 

50 upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

upvar #0 Cjoin [list [namespace current] $ns state] ::] state 

if {$state != "ANT") [ return } 

55 $ canvas lower SELECTED 

$canvas raise SELECTED image 

ant__deselect $ns 
click_reset $ns 

60 

) 

proc iat : : canvas : :make_cmds { ns lvl > ( 
variable TRACE 

65 if {$ TRACE] { puts "iat: : canvas : :make__cmds: $ns $lvl n ) 

set str nn 

#append str "\nbegin canvas \n" 

70 set 1st [get_borders $ns] 
#append str "borders" 

# border percent widths 

#append str ■ [lindex $lst 0] [lindex $lst 1] [lindex $lst 2] [lindex $lst 3]" 

# border color 

75 #append str ■ [lindex $lst 4]\n M 
set pre [string repeat " " $lvl] 
append str »$pre<canvas>\n" 

append str "$pre <border color=\" [lindex $lst 4]\ M > [lrange $lst 0 3] </border>\n" 
append str "$pre</canvas>\n n 
30 #append str "end canvas \n\n" 
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) 



proc iat: • canvas :: an t_make_image { ns } { 
5 variable TRACK 

if {$TRACE} { puts "iat :: canvas :: an t_jJiake_image : $ns" 



} 



upvar #0 tjoin [list [namespace current] $ns canvas] ::] canvas 

upvar #0 [join [list [namespace current] $ns image] ::] image 

10 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

upvar #0 [join [list [namespace current] $ns state] ::] state 

$annotations erase 
click_reset $ns 
15 $annotations draw all 

set img [image create photo -format window -data $canvas] 

return $img 



20 } 



25 



30 



35 



40 



proc iat : : canvas : : ant_ makers vg { ns 
variable TRACE 

if {$ TRACE} { puts "iat: : canvas ; 



upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 



[join 
[join 
[join 
[join 
[join 



[list 
[list 
[list 
[list 
[list 



[join [list 
[join [list 



[namespace 
[namespace 
[namespace 
[namespace 
[namespace 
[namespace 
[namespace 



> { 

: ant_make_svg : $ns " } 

current] $ns image] ::] image 

current] $ns annotations] ::] annotations 

current] $ns borderL] : : ] borders 

current] $ns borderT] : : ] 

current] $ns borderR] :;] 

current] $ns borderB] : : ] 

current] $ns borderColor] 



borderT 
borderR 
borderB 

: : ] borderColor 



45 



set ix [image width $image] 
set iy [image height $ image] 

$annotations erase 

set rvs [$annotations make svg] 

set menu [lindex $rvs 0] 

set ants [lindex $rvs 1] 

#click_reset $ns 

$annotations select 

$annotations draw all 

return [list $borderL $borderT $borderR $borderB $borderColor $ix $iy $menu $ants] 



} 



proc iat : : canvas : : ant_reacL_cmds { ns doc } { 
variable TRACE 

50 if {$TRACE} { puts n iat :: canvas :: an t__readL_cmds : $ns $doc" ) 

upvar #0 [join [list [namespace current] $ns image] ::] image 

upvar #0 [join [list [namespace current] $ns annotations] ::J annotations 

upvar #0 [join [list [namespace current] $ns borderL] ::] borderL 

upvar #0 [join [list [namespace current] $ns borderT] ::] borderT 

upvar #0 [join [list [namespace current] $ns borderR] ::] borderR 

upvar #0 [join [list (namespace current] $ns borderB] ::] borderB 

upvar #0 [join [list [namespace current] $ns borderColor] ::] borderColor 



55 



60 



65 



70 



75 



30 



upvar #0 [join [list $doc doc_>y_eid] ::] doc_j3y_eid 
upvar #0 [join [list $doc doc_by„elt] ::] doc_J>y_elt 

if {[info exists doc_by_elt (border) ] } { 
set eids $doc_by_elt (border) 
#puts ■ eids = $eids M 
set eid [lindex $eids end) 

#puts • $doc_by_eid($eid) " 
array set A $doc_by — eid($eid) 
array set 0 $A{opt> 



if 



if 



{[info exists O(color)J) { 
set borderColor $0 (color) 
#puts n color = $borderColor B 

{[info exists A(dat)]} { 
set B $A(dat) 
#puts ■ B = $B° 
set borderL [lindex $B 0] 
set borderT [lindex $B 1] 
set borderR [lindex $B 2] 
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Append! jF 2" 

set borderB [lindex $B 3] 

) 

} 

5 

$annotations readL_cmds $doc 
return 0 

> 

0 

proc iat z : canvas : : dump_annotations { ns } { 

upvar #0 [join [list [namespace current) $ns annotations] ::] annotations 
5 $annotations dump 

) 

proc iat : : canvas : : dump_keys { ns > { 
° upvar #0 [join [list [namespace current] $ns annotations) ::] annotations 

$ annotations dump_keys 
clicK-reset $ns 
:5 $annotations draw all . 

> 

proc iat: : canvas : :dump_svg { ns } { 
0 upvar #0 [join [list [namespace current] $ns annotations] ::] annotations 

$annotations dump_svg 
click_reset $ns 
15 $annotations draw all 

} 

proc iat: : canvas : :ant_make_ps { ns filename {height 5i) } { 
10 variable TRACE ' B . 

if {$TRACE> { puts "iat: : canvas : :andLmake_ps: $ns $filename } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 

15 #set font*top(-*-Arial-bold-*-*-*-24-*) [list Arial 24] 

#set fontMap(-*-Helvetica-*-*-*-*-*-*> [list Arial 24] 

$canvas create rect 0 0 [$canvas cget -width] [$canvas cget -height] -fill #222 -tags forPS 
$canvas lower forPS 

#return [$canvas postscript -pageheight $height -colormode gray J 
50 #set PS [$canvas postscript -pageheight $height] 

set PS [$canvas postscript -file $filename] 
$canvas delete forPS 
return $PS 

} 

55 iat . icons . txt 
# iat . icons . tcl 



namespace eval iat: : icons { 

50 

set SelectSolid {\ ^„* v 
R0 IGODlhFAAUAPc AAAAAAAAAQAAAg AAA/ wAg AAAgQ AAgg AAg / wBAAABAQABA\ 

g ABA / wBgAABgQABggABg / wCAAAC AQ ACAg ACA/ wCgAACgQACgg ACg / wDAAADA\ 
QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 

65 ACBAQCBAgCBA/yBgACBgQCBggCBg / yCAACCAQCCAgCCA/ yCgACCgQCCggCCg \ 

ZyDAACDAQCDAgCDA/yD/ ACD/QCD/gCD/ / OAAAEAAQEAAgEAA/ 0 Ag AE AgQEAg \ 
gEAg/ OBAABBAQEBAgEBA/ OBgAEBgQEBggEBg/ OCAAECAQECAgBCA/ OCgAECg \ 
QECggECg/ ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQGAAgGAA/ 2Ag \ 
AGAgQGAggGAg / 2BAAGBAQGBAgGBA/ 2BgAGBgQGBggGBg / 2CAAGCAQGCAgGCA\ 

7 0 / 2 Cg AGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2D/ AGD / QGD/ gGD / / 4 AAAIAAQI AA\ 

glAA/ 4 AgAIAgQIAgglAg/ 4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg/ 4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA/ 6AgAKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6 BgAKBgQKBggKBg \ 
/ 6 CAAKCAQKC AgKCA / 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6 ^ /A ^/?™{; 

75 gKD//E 



AMD/QMD/gMD/ / / 8AAP8AQP8AgP8 A/ / 8gAP8gQP8ggP8g/ / 9 AAP9AQP9AgP9A\ 
/ /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP/AQP/A\ 
gP/A/ // / AP/ /QP//gP/ / / yH 5BAEAAP 8 ALAAAAAAUABQAAAhL AP 8 JHEiwoMGD \ 
80 AhIqXCjgoECGEB3+g8hQ4kSKCSlepKhxY0WLGBtKDCkS4UKPJQt+9GhSocqM\ 
L 1 1 2 RDmT 5 sy VGnHmlFmTZ 8 2 f BAMCADs = \ 
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> 

set Polygon {\ 

R0lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/wAgAAAgQAAggAAg/wBAAABAQABA\ 
5 gABA/ wBgAABgQABggABg / wCAAAC AQACAgAC A/ wCgAACgQACggACg / wDAAADA\ 

QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/yCgACCgQCCggCCg\ 
/yDAACDAQCDAgCDA/yD/ACD/QCD/gCD/ / OAAAEAAQEAAgEAA/ OAgAEAgQEAgN 
gEAg / OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg/ OCAAECAQECAgECA/ OCgAECg \ 

10 QECggECg/ ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQGAAgGAA/ 2 Ag \ 

AGAgQGAggGAg / 2 BAAGBAQGBAgGBA / 2 Bg AGBgQGBggGBg / 2CAAGCAQGCAgGCA\ 
/ 2 CgAGCgQGCggGCg / 2 DAAGDAQGDAgGDA / 2D / AGD/ QGD/ gGD/ / 4 AAAX AAQI AA \ 
glAA/ 4 AgAI AgQIAggI Ag / 4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg / 4CAAICAX 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 

15 AKAAQKAAgKAA / 6 Ag AKAgQKAggKAg / 6 BAAKBAQKBAgKBA / 6 Bg AKBgQKBg gKBg \ 

/ 6 C AAKCAQKC AgKC A/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8AgAMAgQMAggMAg/ 8BAAMBAQMBAgMBA/ 8BgAMBg\ 
QMBggMBg / 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ / 9 AAP9AQP9AgP9 A\ 

20 //9gAP9gQP9ggP9g//+AAP+AQP+AgP+A//+gAP+gQP+ggP+g///AAP/AQP/A\ 
gP/A/ / / / AP/ /QP/ /gP/ / / yH 5 BAEAAP 8 ALAAAAAAUABQAAAhPAP 8JHEi WOMGD \ 
CA8KWJhQ4cKHAhoOhEhxIkOCFSlWxHhRoMaOHi^^ 
Fl /C j ChzZs2GGyWGvIkTpU6LLX8KHXowIAA7 \ 

> 

25 

set Point {\ 

RO IGODlnFAAUAPcAAAAAAAAAQAAAgAAA/ wAgAAAgQAAggAAg / wBAAAB AQABA \ 

gABA/ wBgAABgQABggABg / wCAAACAQACAgACA/wCgAACgQACggACg / wDAAADAX 
QADAg AD A / wD / AAD / Q AD / g AD / / yAAAC AAQC AAgCAA/yAg ACAgQC AggC Ag / yBA \ 

30 ACBAQCBAgCBA /yBgACBgQCBggCBg /yCAACCAQCCAgCC A / y CgACCgQCCg gCCg \ 

/yDAACDAQCDAgCDA/yD/ACD/ QCD/gCD/ / OAAAEAAQEAAgEAA/ OAgAEAgQEAg\ 
gEAg / OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg / OCAAECAQECAgECA/ OCgAECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD/ AED/QED/ gED/ / 2 AAAGAAQGAAgGAA/ 2 Ag \ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2 C AAGC AQGC AgGCAX 

35 / 2 CgAGCgQGCggGCg /2DAAGDAQGDAgGDA/ 2D /AGD/QGD/ gGD/ / 4AAAIAAQIAAN 

glAA/ 4AgAIAgQIAggIAg/4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/ 4CAAICAN 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA / 6 Ag AKAgQKAggKAg / 6 BAAKBAQKBAgKBA/ 6 Bg AKBgQKBg gKBg \ 
/6CAAKCAQKCAgKCA/6CgAKCgQKCggKCg/6DAAKDAQKDAgKDA/6D/AKD/QKD/\ 

4 0 gKD/ / 8 AAAMAAQMAAgMAA/ 8 AgAMAgQMAggMAg / 8BAAMBAQMBAgMBA/ 8BgAMBg \ 

QMBggMBg / 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg / 8DAAMDAQMDAgMDA/ 8D / \ 
AMD/QMD/gMD/ / / 8AAP8 AQP8 AgP8A/ / 8gAP8gQP8ggP8g/ / 9AAP9AQP9AgP9 A\ 
/ / 9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP/AQP/AX 
gP/A/ / / / AP/ /QP/ / gP / / /yH5BAEAAP8ALAAAAAATJABQAAAgvAP8 JHEiwoMGD \ 

4 5 CBMqXMiwocOHEBkKmAhxosWHFi k 6 z C i gos a I IEOKHEmypMmBAQEAOw== \ 

} 

set Color {\ 

RO IGODlnFAAUAPcAAAAAAAAAQAAAgAAA / wAgAAAgQAAggAAg / wBAAABAQ ABA\ 

50 gABA/wBgAABgQABggABg/wCAAACAQACAgACA/wCgAACgQACggACg/wDAAADA\ 
QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA/yD/ ACD/ QCD/gCD/ / OAAAEAAQEAAgEAA/ OAgAEAgQEAg \ 
gEAg / OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg/ OCAAECAQECAgECA/ OCgAECg \ 

55 QECggECg / 0 D AAED AQEDAgEDA / OD / AED / QED / gED / / 2 AAAGAAQGAAgGAA/ 2 Ag \ 

AGAgQGAggGAg/ 2 BAAGBAQGBAgGBA / 2 Bg AGBgQGBggGBg / 2 C AAGC AQGC AgGCA V 
/ 2Cg AGCgQGCggGCg / 2 DAAGDAQGDAgGDA/ 2 D/ AGD/ QGD / gGD/ / 4 AAAI AAQI AA\ 
gIAA/4AgAIAgQIAggIAg/ 4BAAIBAQIBAgIBA / 4BgAIBgQIBggIBg/ 4CAAICAX 
QICAgICA/ 4CgAICgQICggICg / 4 DAAID AQXDAglDA / 4D/ AID/QID/gID/ / 6 AA\ 

60 AKAAQKAAgKAA/ 6AgAKAgQKAggKAg/6BAAKBAQKBAgKBA/6BgAKBgQKBggKBg\ 

/6CAAKCAQKCAgKCA/6CgAKCgQKCggKCg/6DAAKDAQKDAgKDA/6D/AKD/QKD/\ 
gKD/ / 8 AAAMAAQMAAgMAA/ 8 AgAMAgQMAggMAg/ 8BAAMBAQMBAgMBA/ 8BgAMBg \ 
QMBggMBg/ 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ /9AAP9AQP9AgP9A\ 

65 / / 9gAP9gQP9ggP9g/ / +AAP+AQP+AgP+A/ / +gAP+gQP+ggP+g/ / / AAP/AQP/ A\ 

gP/A/ / / /AP/ /QP/ /gP/ / / yH5 BAEAAP 8 AI/AAAAAAUABQAAAhhAP 8 JHEiwoEEB \ 
CBMqX JhQoACD / xBC f Bhx4 sOLPSl SLC j xoEOLGUNWPLiRoEaQGDG05FhyoEaG\ 
MBU6 j Enz 1 8inUEO/ i 1 L j Tps qGKXWG 5DnU5 0 igGYUGLXry 5 1 CXNGFCnGowl AA7 \ 

) 

70 

set Line {\ 

RO IGODlnFAAUAPcAAAAAAAAAQAAAgAAA / wAgAAAgQAAggAAg / wBAAABAQABAN 

gABA/wBgAABgQABggABg /wCAAACAQACAgACA/wCgAACgQACggACg / wDAAADAN 
QADAg ADA/ WD/ AAD/ QAD/ gAD / /yAAACAAQC AAgCAA/yAg ACAgQC AggCAg /yBA \ 

7 5 ACBAQCBAgCBA/yBgACBgQCBggCBg/yCAACCAQCCAgCCA/yCgACCgQCCggCCg \ 

/yDAACDAQCDAgCDA/yD/ ACD/QCD/gCD/ / OAAAEAAQEAAgEAA/ OAgAEAgQEAgN 
gEAg/ OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg / OCAAECAQECAgECA/ OCgAECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQGAAgGAA/ 2 Ag \ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA / 2 Bg AGBgQGBggGBg / 2 CAAGC AQGC AgGCA\ 

80 / 2 CgAGCgQGCggGCg / 2DAAGDAQGD AgGDA / 2 D / AGD / QGD / gGD / / 4 AAAI AAQI AA \ 

glAA/ 4 AgAlAgQIAgglAg/ 4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg / 4CAAICAX 
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Q ICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 

AKAAQKAAgKAA/ 6 AgAKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6BgAKBgQKBggKBg\ 
/6CAAKCAQKCAgKCA/6CgAKCgQKCggKCg/6DAAKDAQKDAgKDA/6D/AKD/QKD/\ 



AMD/QMD/gMD// / 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ / 9 AAP9AQP9 AgP9A\ 
/ / 9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ / +gAP+gQP+ggP+g/ / / AAP/ AQP/ A\ 
gP/A/ / / MP/ /QP/ /gP/ / /yH5BAEAAP8ALAAAAAAUABQAAAg/AP8 JHEiwoMGD\ 



IyVam/ Ei zpsCAADs= \ 



> 



set Cut (\ 

RO lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/ wAgAAAgQAAggAAg / wBAAABAQABA\ 

g ABA/wBgAABgQABggABg/wCAAACAQACAgACA/wCgAACgQACggACg/wDAAADA\ 
QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCC A/yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA/yD/ACD/QCD/gCD/ / OAAAEAAQEAAgEAA/OAgAEAgQEAg\ 
gEAg / 0 BAAEBAQEBAgEBA/ 0 BgAEBgQEBggEBg / 0 CAAECAQEC AgECA/ 0 Cg AECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD / AED / QED / gED / / 2 AAAGAAQG AAgGAA/ 2 Ag \ 
AGAgQGAggGAg/ 2BAAGBAQGBAgGBA/ 2BgAGBgQGBggGBg/ 2CAAGCAQGCAgGCA\ 
/ 2CgAGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2D/ AGD/QGD/gGD/ / 4 AAAIAAQIAA\ 
glAA/ 4 AgAI AgQIAggI Ag / 4BAAIBAQIBAg IBA/ 4 Bg AIBgQIBgg IBg / 4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA/ 6AgAKAgQKAggKAg / 6BAAKBAQKBAgKBA/ 6BgAKBgQKBggKBg \ 
/ 6 CAAKC AQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/AKD/QKD/ \ 



AMD/QMD/gMD/ / / 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ / 9AAP9AQP9AgP9A\ 
//9gAP9gQP9ggP9g//+AAP+AQP+AgP+A//+gAP+gQP+ggP+g///AAP/AQP/A\ 
gP/A/ / //AP//QP/ /gP/ / /yH5BAEAAP8ALAAAAAAUABQAAAheAP8JHEiwoEEB\ 
CAO eTPhP ADiGChs 6 FC AQ4UOKC i 1C 1 1 iRIMeCHweGBDkR4 8 iFF 0 9mLHkxIklw \ 
LVl 6 dBhTps SLNSNy VDkz Js +bEIF 2 zrFg S 5 ca iK3 3iriNEpO qM6 gNg 0 GBAA7 \ 

} 

ROlGODlh^^ 

gABA/wBgAABgQABggABg / wCAAACAQACAgACA/ wCgAACgQACggACg / wDAAADAX 
QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg/ yCAACCAQCCAgCCA/ yCgACCgQCCggCCg \ 
/y DAACDAQCDAgCD A/ yD / ACD / QCD / gCD / / 0 AAAEAAQEAAgEAA/ 0 AgAEAgQEAg \ 
gEAg / 0 BAAEBAQEBAgEBA/ 0 BgAEBgQEBggEBg / 0 CAAECAQEC AgECA/ OCgAECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD/ AED / QED / gED/ / 2 AAAGAAQG AAgGAA/ 2 Ag \ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2BgAGBgQGBggGBg / 2 CAAGCAQGC AgGCA\ 
/ 2CgAGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2D/ AGD/QGD/gGD/ / 4AAAIAAQIAAX 
gIAA/4AgAIAgQIAggIAg/4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID/ / 6AA\ 
AKAAQKAAgKAA/ 6 AgAKAgQKAggKAg / 6BAAKBAQKBAgKBA/ 6BgAKBgQKBggKBg\ 
/ 6 CAAKC AQKCAgKCA/ 6CgAKCgQKCggKCg / 6DAAKDAQKDAgKDA/ 6D/ AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 AgAMAgQMAggMAg / 8 BAAMBAQMBAgMBA/ 8BgAMBg \ 



AMD/QMD/gMD/ // 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ /9AAP9AQP9AgP9A\ 
/ /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ Z+gAP+gQP+ggP+g/ / /AAP/AQP/AN 
gP/A/ / / /AP/ /QP/ /gP/ / / yH5 BAE AAP 8 ALAAAAAA0ABQ AAAhG AP8 JHEiwoMGD \ 
AhlKOMhQoUKGBhOmhFhQ 4kKKBB 1 i j HhxY 8aOHgVODDlw JMl / JkmmDIinSY8uN\ 
LyFadGkRpEyJKh+e j PkvIAA7 \ 

) 

set SelectHollow {\ 

RO 1 GODlhFAAUAPc AAAAAAAAAQ AAAg AAA / wAgAAAgQAAggAAg / wBAAABAQABA\ 

gABA/wBgAABgQABggABg / wCAAACAQACAgACA/ WCgAACgQACggACg /wDAAADAN 
QADAgADA/wD/AAD/QAD/gAD//yAAACAAQCAAgCAA/yAgACAgQCAggCAg/yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg / yCAACCAQCCAgCCA/ yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA/yD/ ACD/QCD/gCD/ /O AAAEAAQEAAgEAA/ 0 AgAEAgQEAg \ 
gEAg / OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg/ 0 CAAECAQEC AgECA/ 0CgAECg\ 
QECggECg / ODAAEDAQEDAgEDA/ OD/ AED/ QED/ gED/ / 2 AAAGAAQG AAgGAA / 2 Ag \ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2 CAAGCAQGC AgGCA\ 
/ 2CgAGCgQGCggGCg / 2 D AAGDAQGDAgGD A / 2D/ AGD/QGD/gGD/ / 4AAAIAAQIAA\ 
glAA/ 4 AgAIAgQIAggIAg/4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg/ 4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA / 6 AgAKAgQKAggKAg/ 6 BAAKBAQKBAgKB A/ SBgAKBgQKBggKBg \ 
/ 6 CAAKC AQKCAgKCA / 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/6D/ AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 AgAMAgQMAggMAg / 8 BAAMBAQMBAgMBA / 8BgAMBg\ 
QMBggMBg/ 8C AAMC AQMC AgMCA / 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD///8AAP8AQP8AgP8A//8gAP8gQP8ggP8g//9AAP9AQP9AgP9A\ 
/ /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP /AQP/ A\ 
gP/A/ / / /AP/ /QP/ /gP/ / /yH5BAEAAP8ALAAAAAAUABQAAAhUAP8 JHEiwoMGD \ 
AhlqXC j goECGEB3 +S4iwoUSFBSlKnK j xocV3NHTl\iFKJocpEGKCOU6RNonQ5c<iW\ 
HlOehJnRJMmPI1209Khyp06fNHc+7CkUo9CjDgMCADs=\ 
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ROlGODlhF^ 

gABA/wBgAABgQABggABg / wCAAACAQACAgACA/ wCgAACgQACggACg /wDAAADA\ 
QADAgADA/ wD / AAD / Q AD / g AD / / yAAACAAQCAAgCAA/ yAgAC AgQCAggCAg / yBA\ 
ACBAQC BAgCBA /yBgACBgQCBggCBg / yCAACCAQCC AgCC A/ yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA/yD/ACD/QCD/ gCD/ / OAAAEAAQEAAgEAA/ OAgAEAgQEAg\ 



QECggECg/0DAAEDAQEDAgEDA/0D/AED/QED/gED//2AAAGAAQGAAgGAA/2Ag\ 
AGAgQGAggGAg / 2BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2 C AAGCAQGCAgGCA\ 
/ 2CgAGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2D/AGD/QGD/gGD/ / 4 AAAI AAQIAA\ 
glAA/ 4 AgAIAgQIAgglAg / 4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg/ 4CAAICA\ 
QlCAgICA/ 4CgAICgQICggICg / 4DAAIDAQIDAgIDA/ 4D/ AlD/QID/gID/ / 6AA\ 
AKAAQKAAgKAA/ 6AgAKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6 Bg AKBgQKBggKBg \ 
/ 6CAAKCAQKCAgKCA/ SCgAKCgQKCggKCg / 6DAAKDAQKDAgKDA/ 6D/AKD/QKD/ \ 



QMBggMBg/ 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8 AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ / 9AAP9AQP9 AgP9A\ 
//9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP/AQP/A\ 
gP/ A/ / / /AP/ /QP/ /gP/ / /yHSBAEAAP 8 AL AAAAAAUABQAAAhQAP 8 JHEiwoMGD \ 
>0 /wQIQMhQoUKGBx0uhEhQ4kOKAi9 epOgw4 8aGEz ly /NgRpMGPBUtWRDnQosuQN 

Kl9aPAmTZkqWMVdi3KgS5EScEX/WNl3cRYUAAOw==\ 

) 

set Circle {\ 

?5 Qk3 oBAAAAAAAADYAAAAoAAAAFAAAABQAAAABABgAAAAAAAAAAAASCwAAEgs A\ 
" AAAAAAAAAAAA4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh\ 

4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4e^ 

4eHh4eHhzs70ioqKTk50Hx8fBAQEBAQEBAQEHx8fTk50ioqKzs704eHh4eHh\ 
30 4 eHh4eHh4eHh4eHh4eHh4eHhpqairiRkZGExMTVldXk50TwsI^ 
VldXExMTRkZGpqam4eHh4eHh4eHh4eHh4eHh4eHhpqar^ 
4eHh4eHh4eHh4eHh4eHh4eHhm5ubOze7MDAwpqam4eHh4eHh4eHh4eHh 
RkZGOzs7sbGx4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhsbGxOzs7RkZG\ 
zs704eHh4eHh4eHhioqKExMTm5ub4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh 
35 4eHh4eHh4eHhm5tibExMTioqK4eHh4eHh4eHhTk50VldX4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhVldXTk504eHh4eHh4eHhHx8f\ 
k50T4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhk50T^ 
Hx8f4eHh4eHh4eHhBAQEwsLC4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHhwsLCBAQE4eHh4eHh4eHhBAQE3d3d4eHh4eHh4eHh4eHh\ 
4 0 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh3d3dBAQE4eHh4eHh4eHhBAQE\ 
wsLC4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh^^ 
BAQE4eHh4eHh4eHhHx8fk50T4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHhk5OTHx8f4eHh4eHh4eHhTk50VldX4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhVldXTk504eHh4eHh4eHhioqK\ 

4 5 ExMTm5ub4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHhm5ubExMT \ 

ioqK4eHh4eHh4eHhzs70RkZGOzs7sbGx4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHhsbGxOzs7RkZGzs704eHh4eHh4eHh4eHhpqamMDAwOzs7m5\ib4eHh\ 
4 eHh4 eHh4 eHh4 eHh4 eHh4 eHhm5ubOz s 7MDAwpqam4 eHh4 eHh4 eHh4 eHh4 eHh\ 
4eHhpqainRkZGExMWldXk50TwsIX3d3dws 

50 4eHh4eHh4eHh4eHh4eHh4eHh4eHhzs70ioqKTk50Hx8 f BAQEBAQEBAQEHx8 f \ 

Tk50ioqKzs704eH^4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHJi4eHhAAA=\ 

} 

55 set Rectangle {\ 

Qk3 oBAAAAAAAADYAAAAoAAAAFAAAABQAAAABABg AAAAAAAAAAAASCwAAEgs A\ 

AAAAAAAAAAAA4 e Hh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh\ 
4 eKh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

60 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHn4eHh4eHh4eHh4eHh4eHh4eHh4e 

4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eH^ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhAAAAAAAA/ / / / AAAA/ / / /AAAA\ 
/ / / / AAAA/ / / / AAAA/ / / /AAAA/ / / /AAAA/ / / /AAAA/ / / /AAAA4eHh4eHh/ / / / \ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh 

65 4eHh/ / / /4eHh4eHliAAAA4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

4eHh4eHh4eHh4eHh4eHh4eHhAAAA4eHh4eHh////4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh////4eHh4eHhAAAA\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHhAAAA4eHh4eHh/ / / /4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

70 4eHh4eHh4eHh4eHh4eHh4eHh////4eHh4eHhAAAA4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eH^4eHli4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhAAAA4eHh4eHh/ / / / \ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh////4eHh4eHhAAAA4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHhAAAA4eHh4eHh/ / / /4eHh4eHh4eHh4eHh4eHh\ 

7 5 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh/ / / /4eHh4eHhAAAA\ 

4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHhAAAA4eHh4eHh////4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4 eHh4eHh4eHh4eHh4eHh/ / / / 4eHh4eHhAAAAAAAA/ / / / AAAA/ / / / AAAA\ 
/ / / / AAAA/ / / / AAAA/ / / / AAAA/ / / / AAAA/ / / / AAAA/ / / / AAAA4eHh4eHh4eHh\ 

8 0 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
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4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhAAA=\ 

) 

5 set Blank i\ 

R0lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/wAgAAAgQAAggAAg/wBAAABAQABA\ 

gABA / wBgAABgQ ABgg ABg ZwCAAACAQACAgACA/wCgAACgQACggACg / wDAAADAN 
Q ADAgADA / wD/ AAD / QAD / gAD / / yAAACAAQC AAgCAA/yAgACAgQCAggCAg /yBA \ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCC AgCC A/yCgACCgQCCggCCg \ 

1 0 /yDAACDAQCDAgCDA/yD/ ACD/QCD/ gCD/ / 0 AAAEAAQBAAgE AA / 0 AgAEAgQEAg \ 

gBAg / OBAAEBAQEBAgEBA/ 0 Bg AEBgQEBggEBg / 0 CAAECAQECAgECA/ OCgAECgX 
QECggECg/ ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQG AAgGAA / 2 Ag\ 
AGAgQGAggGAg / 2BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2CAAGCAQGCAgGCA\ 
/ 2 CgAGCgQGCggGCg / 2 DAAGD AQGD AgGDA / 2D / AGD / QGD / gGD/ / 4 AAAXAAQ IAA \ 

15 glAA/ 4AgAIAgQIAggIAg/ 4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/4CAAICA\ 

QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA / SAgAKAgQKAggKAg / 6 B AAKB AQKB AgKBA / 6BgAKBgQKBggKBg\ 
/ 6CAAKCAQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 AgAMAgQMAggMAg / 8 B AAMBAQMBAgMBA / 8BgAMBg\ 

2 0 QMBggMBg / 8CAAMCAQMCAgMCA / 8Cg AMCgQMCggMCg / 8 DAAMD AQMDAgMD A / 8D/ \ 

AMD/QMD/gMD/ / / 8AAP8AQP8AgP8A/ / 8gAP8gQP8ggP8g/ / 9 AAP9 AQP9AgP9A\ 
/ /9gAP9gQP9ggP9g/ / +AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP/AQP/A\ 
gP/A/ / / /AP / /QP/ /gP/ / /yH5 BABAAP 8 AL AAAAAAUABQAAAg i AP 8 JHEi woMGD \ 
CBMqXM i woe OHECNKnE i xo s WLGDNq3 Ggxl AA7 \ 

25 } 

set Copy {\ 

Qk3znBAAAAAAAADYAAAAoAAAAFAAAABQAAAABABgAAAAAAIiA£AADEDgAAxA4A\ 

AAAAAAAAAAAA4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

3 0 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHli4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

4 eHh4eHh4 eHh4eHh4eHh4 eHh4 eHh4 eHh4 eHh4eHh4eHh4eHh4eHh4 eHh4eHh\ 
4 eHh 4 eHh 4 eHh 4 e HhgEAAgEAAg E AAgEAAgEAAgE AAgEAAgE AAgEAAgEAA4 eHh \ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhgEAA/ / // // // // // // // // / / \ 
////////// / /gEAA4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHhgEAA\ 

35 ////////////////////////////////gEAA4eHh4eHh4eHh4eHh4eHh4eHh\ 
4eHh4eHh4eHh4eHhgEAA////////////////////////////////gEAA4eHh\ 
4eHh4eHh4eHh4eHhgEAAgEAAgEAAgEAAgEAAgEAA/ ////////////////// /\ 
/////////// /gEAA4eHh4eHh4eHh4eHh4 eHhgEAAwMDAwMDAwMDAwMDAgEAA\ 
//////////// ////////////// //////gEAA4eHh4eHh4eHh4eHh4eHhgEAA\ 

40 wMDAwMDAwMDA W MDAgEAA////////////////////////////////gEAA4eHh\ 
4 eHh 4 eHh 4 eHh4 eHhgEAAwMDAwMDAwMDAwMDAgEAA / ///////////////////\ 
////////// / / gEAA4 eHh4 eHh4 eHh 4 eHh4 eHhgEAAwMDAwMD AwMD AwMD AgEAA\ 
////////////////////////////////gEAA4eHh4eHh4eHh4eHh4eHhgEAA\ 
wMDAwMDAwMDAwMDAgEAA////////////////////////////////gEAA4eHh\ 

4 5 4 eHh4 eHh 4 eHh 4 eHhgEAAwMDAwMDAwMDAwMDAgEAA / ////////////////// /\ 

////////// / / gEAA4 eHh4 eHh4 eHh4 eHh4 eHhgEAAwMDAwMDAwMDAwMDAgEAA \ 
//////////////////////////////// g EAA4eHh4eHh4eHh4eHh4eHhgEAA\ 
wMDAwMDAwMDAwMDAgEAA////////////////////////////////gEAA4eHh\ 
4 eHh4 eHh4 eHh4 eHhgEAAwMDAwMD AwMDAwMDAgEAAgEAAg EAAgEAAgEAAgEAA \ 

50 gEAAgEAAg EAAgE AA4 eHh 4 eHh 4 eHh4 eHh4 eHhgEAAwMDAwMDAwMDAwMDAwMDAX 

wMDAwMDAwMDAg E AA4 eHh 4 eHh 4 eHh4 eHh4 eHh 4 eHh 4 eHh4 eHh4 eHh 4 eHhgEAAN 
wMDAwMDAwMDAwMD AwMDAwMDAwMDAwMDAgEAA 4 eHh4 eHh4 eHh4 eHh4 eHh4 eHh \ 
4 eHh4 eHh4 eHh4 e HhgEAAgEAAgEAAgEAAgE AAgEAAgE AAgEAAgEAAgEAA 4 eHh \ 
4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 

55 4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh\ 
} 

set Pin {\ 

R0 lGODlhPAAUAPc AAAAAAAAAQ AAAg AAA / wAgAAAgQAAggAAg / WB AAAB AQAB A \ 

6 0 gABA /wBgAABgQ ABgg ABg / wCAAACAQACAgACA/ wCgAACgQACggACg /wDAAADAX 

Q ADAgADA / wD / AAD / QAD / gAD / / yAAACAAQC AAgCAA / yAg AC Ag QCAg g CAg / yB A\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/yCgACCgQCCggCCg \ 
/ yDAACDAQCDAgCDA/ yD / ACD / QCD / gCD/ / 0 AAAE AAQEAAgEAA / 0 AgAEAgQEAg \ 
gEAg/ OBAAEBAQEBAgEBA/ OBg AEBgQEBggEBg / OCAAECAQECAgECA/ OCgAECgX 
65 QECggECg / ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQG AAgGAA / 2 Ag \ 

AGAgQGAggGAg / 2 BAAGBAQGB AgGBA/ 2BgAGBgQGBggGBg / 2 CAAGC AQGCAgGCA\ 
/ 2CgAGCgQGCggGCg / 2 DAAGDAQGDAgGD A / 2D/ AGD /QGD/ gGD / / 4 AAAI AAQI AA\ 
gXAA/ 4AgAIAgQIAggIAg/ 4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/4CAAICA\ 
QICAgICA/ 4CgAICgQICggICg/4DAAIDAQIDAgIDA/ 4D/ AID/QID/gID/ / 6AA\ 

7 0 AKAAQKAAgKAA / 6 Ag AKAgQKAggKAg / 6B AAKB AQKBAgKB A/ 6 Bg AKBgQKBg gKBg \ 

/ 6CAAKCAQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA/ 8 Ag AMAgQMAggMAg / 8 BAAMBAQMB AgMB A / 8BgAMBg\ 
QMBggMBg/ 8 CAAMC AQMCAgMCA/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD///8AAP8AQP8AgP8A//8gAP8gQP8ggP8g//9AAP9AQP9AgP9A\ 
7 5 / /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / /AAP/AQP/ A\ 

gP/A/ / / / AP/ /QP/ /gP/ / /y H 5 BAEAAP 8 AL AAAAAAUABQ AAAhF AP 8CTHE i woEGC \ 
AhIqXHliw4MKHAhoifCixIMSKExliFHhx47+OG0E2hCjSIcmSH09SxJjQo8WI\ 
Lk3 GlDkz ZU2bNVver BgQADs = \ 

} 

JO 

set PointerHead {\ 
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R0 lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/ WAgAAAgQAAggAAg / wBAAABAQ ABA \ 

gABA/wBgAABgQABggABg / wCAAACAQACAgACA/ WCgAACgQACggACg / wDAAADA\ 
QADAgADA/ WD / AAD / QAD / gAD / /yAAACAAQC AAgCAA /yAg ACAgQCAggCAg / yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/yCgACCgQCCggCCg\ 
/yDAACDAQCDAgCDA/yD/ ACD/QCD/ gCD/ / 0 AAAEAAQEAAgEAA/ OAgAEAgQEAg\ 
gEAg/ OBAAEBAQEBAgEBA/ 0 BgAEBgQEBggEBg / OCAAECAQECAgECA/ OCgAECg \ 
QECggECg/ ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQGAAgGAA/ 2Ag \ 
AGAgQGAggGAg/ 2BAAGBAQGBAgGBA/ 2BgAGBgQGBggGBg / 2 CAAGC AQGC AgGC A\ 
/ 2CgAGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2D/ AGD/QGD/gGD/ / 4AAAIAAQIAA\ 
glAA/ 4 AgAIAgQIAgglAg / 4 BAA1BAQI BAg IBA/ 4BgAIBgQIBggIBg / 4CAAICA\ 
QlCAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA/ 6AgAKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6 BgAKBgQKBggKBg \ 
/ 6CAAKCAQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/ AKD/QKD/ \ 
gKD/ / 8AAAMAAQMAAgMAA/ 8AgAMAgQMAggMAg/ 8BAAMBAQMBAgMBA/8BgAMBg\ 
QMBggMBg/ 8 CAAMC AQMCAgMC A/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD///8AAP8AQP8AgP8A//8gAP8gQP8ggP8g//9AAP9AQP9AgP9A\ 
//9gAP9gQP9ggP9g//+AAP+AQP+AgP+A//+gAP+gQP+ggP+g///AAP/AQP/A\ 
gP/ A/ / / / AP/ /QP/ /gP/ / /yH5 BAEAAP 8 ALAAAAAAUABQAAAhPAP 8 JFChgoEGC \ 
BxMqXD iw4 EKHDCM+ Z AiRo ICLGC 8axHgwI 8 eGGTuGBOlRpMOTHi s iNDly O sWP \ 
EknGVKkyYcmYLzXif LlTZs+VP/ / VDKowIAA7 \ 



set Move {\ 

RO lGODlhFAAUAPcAAAAAAAAAQAAAgAAA /wAgAAAgQAAggAAg / wBAAABAQABA\ 

gABA / wBgAABgQABggABg / wCAAAC AQACAg AC A/ wCgAACgQACggACg / wDAAAD A\ 
QADAgADA/ WD / AAD / QAD / gAD / / yAAACAAQCAAgCAA / yAg ACAgQCAggCAg / yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/ yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA/yD/ ACD/QCD/ gCD/ / 0 AAAEAAQEAAgEAA/ 0 AgAEAgQEAg \ 
gEAg / OBAAEBAQEBAgEBA/ 0 BgAEBgQEBggEBg / OCAAECAQECAgECA / OCgAECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD/ AED/QED/ gED/ / 2 AAAGAAQGAAgGAA/ 2 Ag\ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2 CAAGCAQGCAgGC A\ 
/2CgAGCgQGCggGCg/2DAAGDAQGDAgGDA/2D/ AGD/QGD/gGD/ / 4AAAXAAQIAA\ 
glAA/ 4 AgAI AgQI Agg I Ag / 4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg / 4CAAICA\ 
QICAgICA/ 4CgAICgQICggICg/ 4DAAIDAQIDAgIDA/ 4D/ AID/QID/gID/ / 6AA\ 
AKAAQKAAgKAA/ 6AgAKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6 BgAKBgQKBggKBg \ 
/ 6CAAKC AQKCAgKCA / 6CgAKCgQKCggKCg/ SDAAKDAQKDAgKDA / 6D/ AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 AgAMAgQMAggMAg / 8 B AAMBAQMB AgMBA / 8BgAMBg \ 
QMBggMBg / 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg/ 8DAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8AAP8AQP8 AgP8 A/ / 8gAP 8gQP8ggP8g / / 9 AAP9 AQP9 AgP9 A\ 
/ /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAF+gQP+ggP+g/ / /AAP/AQP/A\ 
gP/ A/ / / / AP/ /QP/ /gP/ / /yHSBAEAAP 8ALAAAAAAUABQAAAhVAP8 JHDhQgACC \ 
CBMKNGhQoUOGDBOihAhRl3cGKBylOzGiR40KP/OBGLOhxZEiTJy9GxMiypcuX\ 
JxuSVCkzpkqaEzfmlFhT48eKPlv6 j UnSZ9GgIAkGBAA7 \ 



set Code {\ 

RO lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/ WAgAAAgQAAggAAg/ wBAAABAQ ABA\ 

gABA/ WBgAABgQABggABg / wCAAACAQACAgACA/ wCgAACgQACggACg / wDAAADA\ 
Q ADAg ADA/ wD / AAD / QAD / gAD / /yAAACAAQCAAgCAA / yAgAC AgQC AggCAg / yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg /yCAACCAQCCAgCCA/yCgACCgQCCggCCg \ 
/yDAACDAQCDAgCDA / yD / ACD / QCD / gCD / / 0 AAAEAAQEAAgEAA / 0 AgAEAgQEAg \ 
gEAg/ OBAAEBAQEBAgEBA/ OBgAEBgQEBggEBg/ OCAAECAQECAgECA/ OCgAECg \ 
QECggECg / ODAAEDAQEDAgEDA/ OD/AED/QED/gED/ / 2 AAAGAAQGAAgGAA/ 2Ag\ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2 Bg AGBgQGBggGBg / 2 CAAGCAQGC AgGCA\ 
/ 2 Cg AGCgQGCggGCg / 2DAAGDAQGDAgGDA / 2 D / AGD / QGD / gGD / / 4 AAAI AAQI AA\ 
gIAA/4AgAIAgQIAggIAg/4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AA\ 
AKAAQKAAgKAA/ 6 Ag AKAgQKAggKAg / 6 B AAKBAQKBAgKBA / 6 BgAKBgQKBggKBg \ 
/ 6 CAAKC AQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA / 6D/ AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 AgAMAgQMAggMAg / 8BAAMBAQMBAgMBA/ 8BgAMBg\ 
QMBggMBg/ 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg / SDAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8AAP8 AQP8AgP8 A/ / 8gAP8gQP8ggP8g / / 9AAP9 AQP9AgP9 A\ 
//9gAP9gQP9ggP9g//+AAP+AQP+AgP+A//+gAP+gQP+ggP+g///AAP/AQP/A\ 
gP/A/ / / /AP/ /QP/ /gP/ / /yH 5 BAEAAP 8 ALAAAAAAUABQAAAhTAP 8 JHEiwoMGD \ 
CBMqRChAwMCGBCEWdPi PYsWHAi lm3M j xokeMHy 1 S lOhRJEi SFUVKTLmwpcuF \ 
K 1 lmRNlx JEiDJkMy PHI z I s +OEVcK j f myqNGXAQE AOw= = \ 

) 

set PointerMultiple {\ 

RO lGODlhFAAUAPcAAAAAAAAAQAAAgAAA/ WAgAAAgQAAggAAg / wBAAABAQABA\ 

gABA/ WBgAABgQABggABg / wCAAACAQACAgACA/ WCgAACgQACggACg / wDAAADA \ 
QAD Ag ADA/ wD / AAD / QAD / gAD / / yAAACAAQCAAgCAA/ yAgACAgQCAggCAg / yBA\ 
ACBAQCBAgCBA/yBgACBgQCBggCBg / yCAACCAQCCAgCCA/ yCgACCgQCCggCCg \ 
/y DAACDAQCDAgCDA/yD / ACD/QCD / gCD / / 0 AAAEAAQEAAgEAA/ OAgAEAgQEAg \ 
gEAg / OBAAEBAQEBAgEBA/ 0 BgAEBgQEBggEBg / OCAAECAQECAgECA/ OCgAECg \ 
QECggECg/ ODAAEDAQEDAgEDA/ OD/ AED/ QED / gED/ / 2AAAGAAQGAAgGAA/ 2Ag\ 
AGAgQGAggGAg / 2 BAAGBAQGBAgGBA/ 2BgAGBgQGBggGBg / 2CAAGC AQGCAgGCA\ 
/ 2 Cg AGCgQGCggGCg / 2DAAGDAQGDAgGDA/ 2 D / AGD / QGD / gGD / / 4 AAAIAAQI AA \ 
glAA/ 4AgAIAgQI AggIAg/4BAAIBAQIBAgIBA/ 4BgAIBgQIBggIBg/ 4CAAICA\ 
QICAgICA/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AlD/QID/gID//6AA\ 
AKAAQKAAgKAA/ 6 Ag AKAgQKAggKAg/ 6BAAKBAQKBAgKBA/ 6BgAKBgQKBggKBg\ 
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/ 6 CAAKCAQKCAgKCA/ 6CgAKCgQKCggKCg/ 6DAAKDAQKDAgKDA/ 6D/ AKD/QKD/ \ 
gKD/ / 8 AAAMAAQMAAgMAA / 8 Ag AMAgQMAggMAg / 8 BAAMBAQMBAgMB A / 8BgAMBg\ 
QHBggMBg / 8CAAMCAQMCAgMCA/ 8CgAMCgQMCggMCg/ SDAAMDAQMDAgMDA/ 8D/ \ 
AMD/QMD/gMD/ / / 8 AAP8AQP8 AgP8 A/ / 8gAP8gQP8ggP8g/ / 9 AAP9 AQP9 AgP9A\ 
5 / /9gAP9gQP9ggP9g/ /+AAP+AQP+AgP+A/ /+gAP+gQP+ggP+g/ / / AAP/ AQP/AN 

gP/A/ / / /AP/ /QP/ /gP/Y /yH5BAEAAP8ALAAAAAAUABQAAAhYAP8JHEiwoEGB\ 
AhIKMKhwIcGGCR9ClNiQokKLEQdCdKj xYsGKDDl+FCnx4L+MIU2 iHKmSZMeW\ 
MA+uLCnTJUKbJ3HOf DkS5E2 f GzMG 5bgRI Omf HXfm j Ckwl AA7 \ 

) 

10 

set iconList [list SelectSolid Polygon Point Color Line Cut PointerSingle SelectHollow Symbol Circle 

Rectangle Blank Copy Pin PointerHead Move Code PointerMultiple ] 

) 

iat.anfcsvq.txt 
15 # Copyright (c) 2001, University of Utah 

# All rights reserved* 
# 

# iat.antsvg.tcl 

20 namespace eval iat::ant { 
} 

# NOTE I ! ! 

# Modelled after the iat : : roi : : roiDraw* functions 

25 

proc iat : : ant : : midpoint { ptl pt2 } { 
set xl tlindex $ptl 0] 
set yl tlindex $ptl 1) 
set x2 [lindex $pt2 0] 
30 set y2 [lindex $pt2 1] 

set x3 [expr round( ($xl+$x2)/2 )] 
set y3 [expr round( ($yl+$y2)/2 )] 
return tlist $x3 $y33 

) 

35 

proc iat: :ant: :smoothpoly { type pts } { 

set lstpt [lindex $pts end] 
set flip 0 
4 0 foreach pt $pts { 

set mid [midpoint $ lstpt $pt] 

set ql [midpoint $lstpt $mid] 

set q2 [midpoint $mid $pt] 

lappend tmps [join $ql n , n ] 
45 lappend tmps [join $mid °,°] 

lappend tmps [join $q2 

#lappend tmps [join $pt ","] 

set lstpt $pt 

} 

50 set s [lindex $tmps 0] 

set tmps [Ireplace $tmps 0 0] 

lappend tmps $s 

set s [lindex $tmps 0] 

lappend tmps $s 
55 set s "M[lindex $tmps 0]" 

set tmps [Ireplace $tmps 0 0 $s] 

set s n C[lindex $tmps 1]" 

set tmps [Ireplace $tmps 1 1 $s] 

50 # doctor for edge . . . 

' if {$type «= -edge") { 

set s "MClindex $tmps 3] M 
set tmps [Ireplace $tmps 0 3 $s) 
set tmps [Ireplace $tmps end end] 
55 set tmps [Ireplace $tmps end end] 

} 

return $tmps 

) 

70 

proc iat : : ant : : an t_make_svg_po inter { ns ptnum lvl } { 
variable TRACE 

if {$ TRACE} ( puts ° iat : : ant : : ant_jmake_svg_po inter : $ns $ptnum $lvl° } 

75 variable antkey 

variable order 

variable points 

variable heads 

variable verts 
30 variable tails 

variable dSYMs 
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variable dPTRs 
variable kind 
variable code 
variable symbol 
5 variable label 



variable color 
variable linecolor 
variable fillcolor 
0 variable symbolFont 
variable pxl 



#variable styleFontSmall 
#variable styleFontDe fault 
#variable styleFontLarge 



upvar #0 [join [list [namespace current] $ns canvas] 

upvar #0 [join [list [namespace current] $ns imageX] 

upvar #0 [join [list [namespace current] $ns imageY] 

upvar #0 [join [list [namespace current] $ns offsetX] ::] offsetx 

upvar #0 [join [list [namespace current] $ns offsetY] ::] offsetY 



: : ] canvas 
: : ] imageX 
:] imageY 



$xl $yl $x2 $y2 -fill D " -outline yellow -width 2 -tags [list handle $roiKey] 

#set bfsz $styleFontDefault 
\Q #switch $size { 

# "small" { set bfsz $styleFontSmall) 

# "default" { set bfsz $ styleFontDe fault } 

# "large" { set bfsz $styleFontLarge ) 
#) 

J 5 #set bfsz symbolFont 

#set fsz [expr round(ceil < ( ($imageX + $imageY)/2) * 0.001 * $bfsz )>] 

#puts "font size = $fsz" 

#font configure symbol -size $fsz 

10 set headpt [lindex $points $ptnum] 
set tailpt $tails<$ptnum) 
if {$tailpt ==""}{ return } 
set draw_symbol $dSYMs ($ptnum) 
set draw_style $dPTRs ($ptnum) 

i5 

set ptrlen [lindex [x2pts_length $headpt $ tailpt] 0] 
if {[llength $verts ( $ptnum) ] > 0} { 

set angle [x2pts_angle $headpt [lindex $ver ts { $ptnum) 0]] 
} else { 

30 set angle [x2pts_angle $headpt $ tailpt] 

) 

set svgorder iat-$order; append svgorder -point er$ptnum 
set p -p°; set h "h" 
55 #set svgorder 2 $ order; append svgorder 2 head-$ptnum 



#set xl [expr $x -5] 
#set x2 [expr $x +5] 
:5 #set yl [expr $y -5] 
#set y2 [expr $y +5 3 
#$canvas create rect 



set x [lindex $headpt 0] 
set y [lindex $headpt 1] 

set pinfo [ create_pointer $ns $draw_style $ptrlen] 
60 if ($pinfo no -1) { return } 
if {[llength $pinfo] > 1> { 
set hppts $pinfo 
set sub 0 
if <$sub == 1} { 
65 set tmpa [x2pts_angle $headpt $tailpt] 

#puts "tmp angle = $tmpa" 
set ppts [points_rotate $tmpa $ppts] 
set ppts [points_translate_lst $x $y $ppts] 

#$canvas create line " $pointerPoint $symbolPoint" -width 2 -fill blue -tags [list adorner 

70 key$roiKey] 

} else { 

set hppts [points_rotate $angle $hppts] 

set hppts [point s_translate_lst $x $y $hppts] 

) 

75 set tmps [list] 

lappend tmps $headpt 

set tmps [concat $tmps $verts ($ptnum) ] 
lappend tmps $ tailpt 
# makelt breaks down points . . . 
80 set ppts [makelt $ns $ptnum $tmps] 

foreach {x y} $ppts { lappend tmpsl [list $x $y] ) 



WO 2004/057439 - 107 - PCT7US2003/017138 

Appendix 

set traps 1 [smoothpoly area $ traps 1] 
#puts "tmpsl = $tmpsl" 

set traps2 $ppts 
5 lappend tmps2 [lindex $tmps2 0] [lindex $tmps2 1] 

set traps 2 [join $tmps2] 

set traps3 $hppts 

# lappend tmps3 (lindex $tmps3 0] [lindex $tmps3 1] 
10 set traps3 [join $tmps3] 

#$canvas create poly $ppts -smooth true -outline $linecolor -width 1 -fill $fillcolor -tags [list 
ant pointer key$antkey] 

#append str B <polyline id^'testl' style=' f ill :black? f ill -opacity : 0; stroke :black; stroke-width: 3 ' 1 
15 #append str °points= ' $traps2 1 />\n" 

if {$draw_style !« "none") { 

append str "<g id= 1 $ svgorder » >\n" 

append str " <path id* ' $svgorder$p ' style=' fill :$f illcolor; fill-opacity :1; stroke: $f illcolor; 
stroke-width: 3 ' ° 
20 append str "d='$tmpsl* />\n" 

#$canvas create poly $hppts -outline $linecolor -width 1 -fill $f illcolor -tags [list ant 
pointer key$antkey] 

append str ■ <polygon id= 1 $ svgorder $h* style=» fill :$f illcolor ; fill-opacity:!; 
stroke :$f illcolor; stroke-width:3 ' " 
25 append str tt point s= '$ traps 3 ■ />\n B 

• append str "</g>\n" 
} else { 

append str °<g id= » $svgorder ' >\n" 
append str "</g>\n" 

30 } 
} 

set xt [lindex $tailpt 0] 
set yt [lindex $tailpt 1] 
35 # returns e or w 

set gl [iat: :ant : :gravity_label $angle] 
#puts "$angle = $gl" 
set dx 0 
set dy 0 
40 set ta -middle" 
switch $gl ( 

•w" { set ta "start"; set dx $pxl } 
•e B { set ta "end" ; set dx -$pxl ) 
default { set ta "middle" } 

45 } 

# interactive visual note "spot" 

set svgorder iat-$order; append svgorder -inote$ptnum 
#set iszr [expr round ( ceil ( ($imagex + $imageY)/2) * 0.001 * 5)] 
50 append str "<circle id= 1 $ svgorder ' cx=' [expr $xt] ' cy=»[expr $yt] ' r=' [expr $pxl] » style=' fill : blue; 
s t r oke : whi te ; s t roke-width : 2px ■ / > \n ■ 



#if {[regexp -nocase {e) $gl] } { 
55 # set dx [expr round ($fsz* ( [string length $drawtext] /2) ) ] 

# set xt [expr $xt-$dx] 
#) 

#if {[regexp -nocase {w} $gl] } { 

# set dx [expr round($fsz* { [string length $drawtext] /2) ) ] 
60 # set xt [expr $xt+$dx) 

#> 

set bfsz $symbolFont 

set fsz [expr round (ceil (( ($imageX + $imageY)/2) * 0.001 * [font configure $bfsz -size] )>] 
# temporary fix for minimum font size. ♦ . 
65 if {$fsz < 12} { set fsz 12 } 
append fsz pt 
#puts "font size = $fsz" 

set svgorder iat-$order; append svgorder -symbol $ptnum 

70 

switch $draw_symbol { 

"code" { set txt $code } 
"symbol" { set txt $symbol > 
"label" { set txt $label > 
75 "none" { set txt " w ) 

default { set txt "?" } 

) 

append str °<text id=' $ svgorder' x=s'[expr $xt+$dx] ' y='$yt' style=' font-size: $fsz ; baseline-shift: -25%; 
80 text-anchor :$ta; f ill : $£ illcolor • >» 
append str $txt 
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append str "</text>\n" 
return $str 

> 

5 

proc iat: :ant: : ant_jmake_svg_pointers { ns lvl } { 
variable TRACE 

if {$ TRACE} { puts «iat: :ant: :ant_jnake_svg_pointers: $ns $lvl" > 
.0 variable heads 
set str 

for each {key value} [array get heads] { 
if {$value == " n } { continue } 
.5 append str [ant_make_svg.jpointer $ns $key $lvl] 

} 

return $str 

} 

>0 

proc iat: :ant: : ant_make_svg_ant { ns {key ""} lvl } { 
variable TRACE 

if { $TRACE } { puts "iat: :ant: :ant_make_svg_ant: $ns $key $lvl n } 

>5 

variable antkey 
variable order 
variable points 
variable kind 
30 variable symbol 
variable label 
variable caption 

variable color I 
35 variable fillcolor 
variable linecolor 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
upvar #0 [join [list [namespace current] $ns offsetX] ::] offsetX 
10 upvar #0 [join [list [namespace current] $ns offsetY] ::] offsetY 

set key [string tolower $key] 
if {$key =» ■ " } { set key $antkey } 
if {$key == "active"} {set key $antkey } 
15 if {$key =="»}{ return ■ ■ } 

#ant_erase $ns $key 

#if {$key ! = $antkey} { ant_load $ns $key } 
ant_load $ns $key 

50 

ant_draw_precalc $ns 
set str UD 

55 if {$kind == "none 0 } { return } 

if {$kind o- "group"} { 

set gtag "<symbol id=' $order' >\n° 

append gtag "<title> [STRXML "group label"] </title>\n" 

append gtag "<desc>\n" 
50 #append gtag " <symbol> [STRXML "group symbol"] </symbol>\n" 

#append gtag " <label> [STRXML "group label"] </label>\n" 

#append gtag " <caption> [STRXML "group caption"] </caption>\n" 

append gtag "</desc>\n" 

append gtag "</symbol>\n" 
55 return $gtag 

} 

set part "all" 

7 0 #onmouseover= 1 target_vis ible { evt ) » onmouseout= ' targe t.Jiidden ( evt ) • 

switch $part { 
"none" {} 
"pointer" {} 
# all or region 
75 default { 

set tmps [smoothpoly $kind $points] 

set tmps2 $points 
lappend tmps2 [lindex $tmps2 0] 
30 set tmps2 [join $tmps2] 
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set svgorder iat-$order; append svgorder -region 
switch $kind { 
"area" { 

append str "<path id= 1 $ svgorder ' style= 1 f ill: $f illcolor; fill-opacity: 0; 
5 stroke :$f illcolor; stroke-width: 3 * 0 

append str n d=' $ tops' />\n«* 

#append str "<polyline id= ■ $ svgorder- test ' style=' fill : black; fill-opacity: 0; 
stroke: black; stroke-width: 3 1 • 

#append str "points* • $tmps2 ' />\n" 
.0 #$canvas create poly $tmps -outline $f illcolor -width 2 -fill ■ ■ -tags [list roi 

key$roiKey $order] 
) 

"edge" { 

#set tmps [join $points] 

.5 append str "<path id= 1 $ svgorder ' style=» fill: $f illcolor; fill-opacity: 0; 

stroke :$f illcolor; stroke-width : 3 * " 

append str "d='$ traps* />\n° 

#$canvas create line $traps -width 2 -fill $fillcolor -tags [list roi key$roiKey $order] 

> 

;0 # point is default! 

default { 

for each {x y} $tmps { 

#$canvas create oval [expr $x-6] [expr $y-6] [expr $x+6] [expr $y+6] -outline 
$f illcolor -width 3 -fill -tags [list roi key$roiKey $order] 
!5 } 
> 

) 

) 

} 

10 

set svgorder iat-$order; append svgorder -inote 
append str "<g id= ' $svgorder , ></g>\n" 

switch $part { 
15 "none" {} 

"region" {} 

# all or pointer 

default { 

append str [ an t_make_svg_po inters $ns $lvl] 

10 } 
} 

# add 'g' tag for group 
set gtag "<symbol>\n tt 
15 append gtag "<title> [STRXML $label] </title>\n" 

#append gtag "<desc>\n" 

set symid iat-$order; append symid -symbol 

#append gtag 0 <symbol id= , $symid'> [STRXML $symbol] </symbol>\n" 
append gtag " <text id=* $symid , > [STRXML $symbol] </text>\n° 
>0 set lblid iat-$order; append lblid -label 

#append gtag " <label id= , $lblid , > [STRXML $label] </label>\n" 
append gtag ■ <text id=»$lblid'> [STRXML $label] </text>\n" 
set capid iat-$order; append capid -caption 

#append gtag ■ <caption id='$capid'> [STRXML $caption] </caption>\n" 
>5 append gtag ■ <text idbs 1 $cqpid 1 > [STRXML $caption] </text>\n" 
#append gtag "</desc>\n° 
append gtag $str 
append gtag 0 \n</symbol>\n 0 

50 return $gtag 



proc iat : : ant : : ant_make_svg_menu { ns lvl } { 
variable TRACE 

55 if {$TRACE} { puts "iat: :ant: :ant_make_svg_menu: $ns $lvl" } 

variable view 

upvar #0 [join [list [namespace current] $ns orders] ::] orders 
7 0 upvar #0 [join [list [namespace current] $ns polys] ::] polys 

upvar #0 [join [list [namespace current] $ns inviews] ::] inviews 
upvar #0 [join [list [namespace current] $ns symbols] ::] symbols 
upvar #0 [join [list [namespace current] $ns labels] ::] labels 

7 5 array set viewArray [list] 

set str »■ 

append str "<defs>\n" 

append str - <menu id='NewMenu' xmlns= *http: //f oo' onload='GetPosition( evt )*>\n" 
30 #append str " <header>Annotation Menu< /header >\n" 
#append str " <separator />\n u 
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append str ■ <menu>\n^ 

append str ■ <header> Annotations </header>\n° 
#append str ■ <separator />\n n 
# create by order 

5 foreach {key val) [array get orders] { set ord2key($val) $key } 

set ords t array names ord2key] 

set ords [Isort -dictionary $ords] 

set arr [list] 

foreach ord $ords { 
0 #append symbols [ant_make_svg_ant $ns $key $lvl] 

set key $ord2key ($ord) 

if {'[info exists polys ($key) ] } { continue } 
if { $polys($key) [list] > { continue } 
lappend arr V$ordV 
5 set ord $orders ($key) 

if {[info exists symbols ($key) ] ) { set sym $ symbols ($key) 
) else { set sym "?" > 

if {[info exists labels ($key) ] > { set lbl $labels($key) 
> else { set lbl "?■ } 
0 set item °menu-$ord B ; append item "-annotation" 

append str n <item id='$item' onactivate='antToggleShowAnt ($ord, true, true) 1 checked='yes' > 
$ord: $lbl </item>\n" 

# setup view data too . . . 

if ([info exists inviews ( $key) ] } { set ivs $inviews ($key) 
5 } else { set ivs nu > 

foreach v [split $ivs] { 

if {[info exist viewArray ($v) ) } { 
set tmp $viewArray($v) 
append tmp ",\'$ord\' B 
0 set viewArray ($v) $tmp 

} else { 

set tmp "\'$ordV B 
set viewArray ($v) $tmp 

} 

5 } 
> 

set arr "\[[join $arr ", B ]\]° 
append str ■ </menu>\n" 
append str 8 <separator />\n" 
.0 append str ■ <menu>\n" 

append str " <header>Views</header>\n" 
set iid ■■ 

if {$view == "ALL"} { set iid n id=\ n currentIATView\ " " > 

append str " <item $iid onactivate=\ " antSetViewText ( 1 ALL 1 ) ; antSetShowAll ( $arr , true , true ) \ B > ALL 
i5 </item>\n" 

set iid " B 

if {$view == "NONE"} { set iid »id=\ B currentIATView\ B ■ } 

append str ■ <item $iid onactivate=\"antSetViewText ( 'NONE' ) ;a ntSetShowAll ($arr, false, true) \ > NONE 
</item>\n" 
")0 set vws [array names viewArray] 

set vws [lsort -dictionary $vws] 
foreach vw $vws { 

set iid , 
if { $view == $vw) { 
j5 set iid " id=\ ■ current I ATViewN ■ n 

> 

set varr $viewArray($vw) 

append str M <item $iid v „ 

onactivate=\ "antSetViewText { 1 $vw' ) ; antSetShowAll ($arr, false, false) ;antSetShowAll ( \ [$varr\] , true, true) \ > 

50 </item>\n- 

> 

append str " </menu>\n° 

append str ■ <separator />\n" 

#append str ■ <item onactivate=\"antToggleShowAll ($arr, true) \ M > Toggle </item>\n 

55 #append str " <item onac tivate=\" ant Se t ShowAl 1 ($arr, true, true) \"> Show </item>\n M 

#append str ■ <item onactivate=\ "antSetShowAll ($arr, false, true) \°> Hide </item>\n° 

#append str " <separator />\n" 

append str ■ <menu>\n B 

append str 0 <header>lnteractivity</ header >\n u 

70 append str " <item id= 'menu-mouseovers ■ onac tivate=\"antToggleMouseOver All ($arr, true) \" checked- no 
Mouseovers </item>\n" 

append str ■ </menu>\n° 

append str " <separator />\n" 

append str " <menu>\n" 

75 append str " <header>Window< /header >\n" 

append str " <item action= ' Zoomln' >Zoom &In</item>\n" 

append str " <item actions • ZoomOut ' >Zoom &Out</item>\n° 

append str ■ <item action= 'Or iginalView' >& Original View</item>\n" 

append str " <item action= 'Quality • >Higher &Quality</item>\n" 

30 append str ■ </menu>\n" 

append str " separator />\n» 
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append str " <menu>\n" 

append str " <header>About</ header >\n" 

append str " <item onactivate= ' antAbout ( ) ' >About Annotations</item>\n ,, 

append str " <item actions • About 1 >About SVG Viewer</item>\n n 

append str ■ <item actions ' ViewSVG * >&amp ? View SVG</item>\n" 

append str • <item action* ' ViewSource • >View Sourc&e</item>\n B 

append str ■ </menu>\n B 

append str " </menu>\n° 

append str °</defs>\n° 

return $str 



} 



proc iat : : ant : : ant _make_svg_views { ns lvl } { 
.5 variable TRACE 

if {$TRACE) { puts "iat: :ant: :ant_make_svg_views: $ns $lvl" } 

# 

# append views in svg <g> tags 
:0 # 

upvar #0 [join [list [namespace current] $ns orders] ::] orders 

upvar #0 [join [list [namespace current] $ns polys] ::] polys 

upvar #0 [join [list [namespace current] $ns aheads] ::] aheads 

upvar #0 [join [list [namespace current] $ns kinds] ::] kinds 

:5 upvar #0 [join [list [namespace current] $ns symbols] ::] symbols 

upvar #0 [join [list [namespace current] $ns labels] ::] labels 

#set allords [list] 

#foreach key [array names iat :: roi :: orders ] { 
;0 # set ord $iat: : roi: : orders ($key) 

# set lbl $iat : : roi : : symbols ( $key ) 

# set txts($ord) "$ord $lbl n 

# set kinds ($ord) $iat :: roi: : kinds ($key) 

# set views ( $ord) $iat : : roi : : views ( $key) 
•5 # lappend allords $ord 

#) 

#set allords [lsort -dictionary $allords] 

set allords [list] 
:0 foreach {key value) [array get polys] { 

set ord $orders ($key) 

set lbl $ symbols ($key)" 

set txts($ord) n $ord $lbl" 

set aheds($ord) $aheads ($key) 
; 5 set knds($ord> $kinds($key) 

set viws($ord) all 

lappend allords $ord 

} 

set allords [lsort -dictionary $allords] 
10 #puts u allords ■ $allords" 

#set viewNames [array names viewData] 
#set viewNames [lsort -dictionary $viewNames] 
set viewNames [list] 
>5 set viewNames [concat [list NONE ALL] $viewNames] 
#puts "viewNames = $viewNames" 
foreach viewName $ viewNames { 
set spc 

set ordStack [list] 
JO set visibility hidden 

if { [info exists vdata] } { unset vdata ) 
if {$viewName == "NONE" } { 

# no annotations . . . 

} elseif {$viewName == "ALL" } { 
55 foreach ord $allords { set vdata ($ord) "all" } 

set visibility visible 
} else { 

#array set vdata $viewData ($viewName) 

> 

F 0 set svg_notes 90 

set ords [array names vdata) 

set ords [lsort -dictionary $ords] 

append svg "<g id= 1 $viewName-view • style=' visibility : $visibility' >\n° 
foreach {ord) $ords { 
'5 set see $vdata($ord) 

#puts w $viewName: $ord = $see\n M 

# don't write groups - no visual annotation 

set orderAnt iat-$ord; append orderAnt -annotation 
set orderRegion iat-$ord; append orderRegion -region 
10 set order Pointer iat -$ ord; append order Pointer -pointer 

set order INote iat-$ord; append orderlNote -inote 
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set order Symbol iat-$ord; append order Symbol -symbol 

#puts » [lindex $ordStack end) == $viewName-$ord" 
5 while {[expr { [llength $ordStack] > 0} && { ! [regexp [lindex $ordStack end] $viewName-$ord] ) ] ) { 

set spc [string repeat " ■ [llength $ordStack] ) 

append svg n $spc</g><! — end [lindex $ordStack end] -annotation — >\n° 
set ordStack [lreplace $ordStack end end] 

) 

.0 

set spc [string repeat ■ ■ [expr [llength $ordStackJ +1]] 

set svg_pointers B " 
foreach {key value) $aheds($ord) { 
.5 if {$value == ■■) { continue } 

#puts " ahed = $key\n B 

append svg_pointers B $spc <use id= ' $viewName-$ order Point er$key' 
xlink:href= , #$orderPointer$key' />\n" 

append svg_pointers -$spc <use id=' $viewName-$orderINote$key • xlink:href=' #$orderINote$key * 
! 0 onmouseover= ' antSetMouseOverlNote ( \ " $ord\ * , \ B $key \ B , true ) 1 

onmouseout= ' antSetMouseOverlNote ( \ » $ord\ n , \ ■ $key\ - , false ) ' />\n" 

append svg_pointers a $spc <use id= * $viewName-$orderSymbol$key ' 
xlink:href= , #$orderSymbol$key l />\n" * , , ™ /^\«. 

append svg_notes B $spc <use id=» $viewName-$ order INote' xlink:href = ' #$orderINote» />\n B 

»5 } 

lappend ordStack $viewName-$ord 
append svg n $spc<g id= » $viewName-$orderAnt 1 
onmouseover= • antSetMouseOverAnt ( \ B $ord\ B , true, false) ' onmouseout= » antSetMouseOverAnt ( \ - $ord\ B , false, false) 
!0 onclick= l antShowCaption(\°$ord\ n ) »>\n" 
switch $see { 
"pointer" { 

#append svg B $spc <use id= ' $viewName-$ order Point er ' xlink:href = ' #$order Pointer • 
onmouseover='onAntMouseOver(evt) ' onmouseout« » onAntMouseOf f ( evt ) » />\n" 
j 5 append svg "$spc <use id= 1 $viewName-$order Pointer » xlink:href = ' #$order Pointer />\n 

append svg "$spc <use id= ■ $viewName-$ order Symbol ' xlink:href=« #$orderSymbol ' />\n" 

) 

"region" { 

#append svg B $spc <use id= ' $viewName-$orderRegion' xlink:href=' #$orderRegion' 
10 onmouseover=»onAntMouseOver(evt) • onmouseout=' onAntMouseOf f (evt) * />\n" 

append svg M $spc <use id= * $viewName-$orderRegion ' xlink:href = • #$orderRegion />\n 

> 

"none" { 

append svg "$spc <! — none — >\n D 

15 ) 

default { 

#append svg B $spc <use id= 1 $viewName-$orderRegion ' xlinkrhref = * #$orderRegxon' 
onmouseover=»onAntMouseOver(evt) 1 onmouseout=' onAntMouseOf f (evt) 1 />\n" 

#append svg "$spc <use id=' $viewName-$orderRegion-test • xlinkrhref = ' #$orderRegion-test 

3 ° />Nn append svg B $spc <use id=' $viewName-$orderRegion' xlink:href=» #$orderRegion' />\n B 

append svg n $svg_pointers\n n . . „ 

#append svg "$spc <use id= ' $viewName-$orderPointer 1 xlink:href = ' #$ order Pointer />\n 
#append svg "$spc <use id=' $viewName-$orderSymbol * xlink:href= ■ #$order Symbol 1 />\n" 

35 #append svg "$spc <use id= * $viewName-testl • xlink:href =' #testl ' />\n° 

#append svg "$spc <use id= * $viewName-test2 ' xlink:href- ' #test2 1 />\n" 

) 

} 

) 

50 while {[llength $ordStack] > 0) { 

set spc [string repeat ■ " [llength $ordStack] ) 

append svg °$spc</g><! — end [lindex $ordStack end] annotation — >\n" 
set ordStack [lreplace $ordStack end end] 

) 

55 append svg B $svg_notes\n n 

append svg °</gxl — end $viewName-view — >\n" 



70 ) 



) 

return $svg 



proc iat: :ant: :ant_make_svg__all { ns lvl } { 
variable TRACE 

if {$ TRACE) { puts "iat: ;ant: : ant_make_svg__all : $ns $lvl" ) 

75 

upvar #0 [join [list [namespace current] $ns polys] ::] polys 



set menu " " 
set symbols " " 
30 set views "" 
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foreach {key value) [array get polys] { 

append symbols [ant_make_svg_ant $ns $key $lvl] 

append views [ ant_make_svg_views $ns $lvl] 
5 append menu [ ant_make_svg_jnenu $ns $lvl] 

return [list "$menu B "$ symbol s \n$views " ] 

> 

iat. tex.txt_ 

.0 # Copyright (c) 2001, 2002, University of Utah 

# All rights reserved. 
# 

# iat.tex.tcl 

.5 package require uri 

namespace eval tex { 
variable TRACE 0 
variable next_nsid 1 

:o 

> 

proc tex: : next _jnsid { } { 
!5 variable next_nsid 

return [incr next_nsid] 

> 

tO namespace eval tex: :doc { } 

proc tex: :proc { ns cmd args } { 
variable TRACE 

if { $TRACE} { puts "tex:: proc: $ns $cmd Sargs" } 



*5 



upvar #0 [join [list [namespace current] doc $ns xml_str] ::] xml_str 



switch $cmd { 

"configure" { 
10 #puts ■ cmd = configure: $args" 

foreach {key value) $args { 

#puts " key = $key & value = $value" 
switch — $key { 

"-xml" { doc_set_xml $ns $value ) 
15 "-url" { doc_set — url $ns $value ) 

"-file" { doc_set_file $ns $value ) 

) 

) 

) 

j0 "cget" { 

#puts " cmd = cget: $args" 
switch — [lindex $args 0] { 

B -url" { return [doc_get_url $ns] ) 

) 

>5 ) 

"read" { 

return [doc_read $ns] 

) 

"parse" { 

50 return [doc_parse $ns $xml__str] 

) 

"dump" { 

doc_dump $ns 

) 

55 default { 

puts "ERROR unknown command = $cmd" 

) 

) 

70 return {) 
) 

proc tex: : create { args ) { 
variable TRACE 
75 if {$ TRACE) { puts "tex: : create: $args" ) 

set nsid [nextjisid] 

set ns [namespace current] : : doc : : id$nsid 

30 

namespace eval $ns { 
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variable xml 

array set xml [list] 

variable ID 999 
variable ns "" 
variable xml_str ■ ■ 

variable url ■ B 

variable eids 
variable tags 
variable opts 
variable dats 
variable nods 



>5 



*0 



} 



variable eid 0 
variable tag "TAG" 
variable opt [list] 
variable dat 
variable nod [list] 

variable doc_by_eid 
variable doc_by_elt 

array set doc_by_eid [list] 
array set doc_fcy_elt [list] 

variable elt_to_widget 
variable elt_eid 



set cmd "proc [namespace current] :: doc: :id$nsid { cmd args } {eval [namespace current] : :proc id$nsid 
\$cmd \$args}" 
$ 5 namespace eval : : $cmd 

eval "[namespace current] :: doc: : id$ns id configure $args" 



10 



} 



return [namespace current] : :doc: :id$nsid 



#proc unknown { args } { 
# puts "unknown: $args B 
#> 

15 proc tex: :clear_state { ns > { 

upvar #0 [join [list [namespace current] doc $ns eids] 

upvar #0 [join [list [namespace current] doc $ns tags] 

upvar #0 [join [list [namespace current] doc $ns opts] 

upvar #0 [join [list [namespace current] doc $ns dats] 



: ; ] eids 
: : ] tags 



30 



opts 
dats 



upvar #0 [join [list [namespace current] doc $ns nods] ::] nods 



35 



set eid 0 
set tag "TAG" 
set opt [list] 
set dat nn 
set nod [list] 



50 



proc tex: :stacK_push { ns } { 





upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns eids] 


t O 


eids 




upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns tags] 


: :] 


tags 


55 


upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns opts] 


: :] 


opts 




upvar 


#0 


[join 


[list 


[namespace 


current) 


doc 


$ns dats] 


::) 


dats 




upvar 


#0 


[join 


[list 


[namespace current] 


doc 


$ns nods] 


::] 


nods 




upvar 


#0 


[join 


[list 


[namespace current] 


doc 


$ns eid] 


: :] 


eid 


70 


upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns tag] 


::] 


tag 




upvar 


#0 


[join 


[list 


[namespace 


current] 


doc $ns opt] 


::3 


opt 




upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns dat] 


: :] 


dat 




upvar 


#0 


[join 


[list 


[namespace 


current] 


doc 


$ns nod] 


::] 


nod 



75 if {I [info exists eids (_TOS_) ] } { set eids(_TOS_) 0 ) 

incr eids(_TOS_) 
set TOS $eids (_TOS_) 
set eids($TOS) $eid 
30 set tags($T0S) $tag 
set opts($TOS) $opt 
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set dats($TOS) $dat 
set nods($TOS) $nod 

cleans tat e $ns 



proc tex: ;stack^_pop { ns } { 

upvar #0 [join [list (namespace current] doc $ns eids] ::] eids 

0 upvar #0 [join [list [namespace current] doc $ns tags] ::] tags 

upvar #0 [join [list [namespace current] doc $ns opts] ::] opts 

upvar #0 [join [list [namespace current] doc $ns dats] ::] dats 

upvar #0 [join [list [namespace current] doc $ns nods] ::] nods 

.5 upvar #0 [join [list [namespace current] doc $ns eid] ;:] eid 

upvar #0 [join [list [namespace current] doc $ns tag] ::] tag 

upvar #0 [join [list [namespace current] doc $ns opt] ::] opt 

upvar #0 [join [list [namespace current] doc $ns dat] ::] dat 

upvar #0 [join [list [namespace current] doc $ns nod] ::] nod 

>0 

if {I [info exists eids (_TOS_> ] } { return 0 } 
if {$eids(_TOS_) == 0} { return 0 } 



set TOS $eids(_TOS_) 
25 set eid $eids($TOS) 
set tag $tags($TOS) 
set opt $opts{$TOS) 
set dat $dats($TOS) 
set nod $nods{$TOS) 
30 incr eids(__TOS_) -1 

#puts "nodes: $nod" 

unset eids<$T0S) 
35 unset tags($TOS) 
unset opts($TOS) 
unset dats<$T0S) 
unset nods($TOS) 



40 return 1 
> 

proc tex: : tos_adcL_node { ns n > { 
variable TRACE 
45 if {$TRACE} { puts n tex : ; stack_addUnode : $n" } 

upvar #0 [join [list [namespace current] doc $ns eids] ::] eids 

upvar #0 [join [list [namespace current] doc $ns tags] ::] tags 

upvar #0 [join [list [namespace current] doc $ns opts] ::] opts 

50 upvar #0 [join [list [namespace current] doc $ns dats] ::] dats 

upvar #0 [join [list [namespace current] doc $ns nods] ::] nods 

if (![info exists eids <_TOS_) ] } { return 0 ) 



55 lappend nods($eids(_TOS_) ) $n 

#puts 0 tos nodes: $nods {$eids(JTOS_J ) ■ 



return 1 

) 

60 

proc tex: :setjiode { ns eid tag opt dat nod } { 
variable TRACE 

if { $TRACE} { puts "tex: :set_node: $ns $eid $tag . .." } 

65 upvar #0 [join [list [namespace current] doc $ns docjDy_eid] ::] doc_by_eid 
upvar #0 [join [list [namespace current] doc $ns doc_py_elt] ::] doc_by_elt 



70 } 



set do03y_eid($eid) [list eid $eid tag $tag opt $opt dat $dat nod $nod] 
lappend doc_by_elt ($tag) $eid 



proc tex: :doc_dump { ns } < 
variable TRACE 

if {$ TRACE} { puts "tex: :doc_dump: $ns n } 
75 _ 

upvar #0 [join [list [namespace current] doc $ns xml] ::] xmi 

upvar #0 [join [list [namespace current] doc $ns doc_by_eid] ::] doc^by^eid 

upvar #0 [join [list [namespace current] doc $ns doc_by_elt] ::] doc_by_elt 



80 puts ■ D 

set keys [array names xml] 
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$xml($key)" 



foreach key $keys { 
puts "xml $key = 

> 

set eids [array names docJby_ eid) 
set eids Clsort -integer $eids] 
f oreach eid $eids { 

#puts ■ eid $eid = $doc Jv_«id ( $eid) ' 

array set A $doc_by_eid($eid) 

puts • " 

puts • eid: $A(eid)' 



puts 
puts 
puts 
puts 



tag: 
opts: 
data: 
nodes : 



$A(tag>" 
$A<opt)« 
\ n $A(dat)\"" 
$A(nod) B 



} 

proc tex: : slave_unknown { ns cmd args } { 
10 variable TRACE 

if {$TRACE} { puts "tex: : slave_unknown: $ns $cmd $args" ) 



£5 



50 



upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 
upvar #0 



[join 
[join 
[join 
[join 
[join 
[join 
[join 
[join 



[list 
[list 
[list 
[list 
[list 
[list 
[list 
[list 



[namespace 
[namespace 
[namespace 
[namespace 
[namespace 
[namespace 
[namespace 
[namespace 



current] 
current] 
current ] 
current] 
current] 
current] 
current] 
current] 



doc $ns 
doc $ns 
doc $ns 
doc $ns 
doc $ns 
doc $ns 
doc $ns 
doc $ns 



xml] 

ID] 

eid] 

tag] 

opt] 

dat] 

nod] 

tns] 



: : ] xml 
:] ID 
: : ] eid 
: : ] tag 
: : ] opt 
: : ] dat 
: : ] nod 
: : ] tns 



J5 



#set tag [lindex $args 0] 
#set data $args 



#puts "length: [llength $data] ■ 
if {[regexp {*<\?xml} $cmd mat] } { 

# xml document . . - 

f oreach token $args { 
JO if ($token == "?>«} ( 

break 

} elseif {[regexp { (\w+) = (\ ■ | \» ) (\S+) (\ ' | \- > > $ token mat key a val b] > { 
#puts "option: $key « \"$val\ no 
set xml($key) $val 

15 ) 
} 

clear. state $ns 
} elseif {[regexp {*<! — } $ cmd mat] } { 
30 # comment 

> elseif {[regexp {*</<\S+)>) $ cmd mat tag]} { 

# close tag 

stack_pop $ns 
35 set dat [string trim $dat] 

tos.addUnode $ns $eid 

set^node $ns $eid $tag $opt [XMLSTR $dat] $nod 

#puts " eid: $eid" 

60 #puts ■ tag: $tag" 

#puts " opts: [array get opt] " 

#puts ■ data: \"$dat\" tt 

#puts ° nods: $nod" 

65 clear_state $ns 

} elseif {[regexp {*<(\S+)>> $ cmd mat tag]} { 

# start tag 

#puts ■ tag start = $tag" 
70 set eid [incr ID] 

set endUtag 0 
set is_data 1 
set opt [list] 
75 set dat 

set nod [list] 
foreach token $args { 
if {$is_data} { 

if {[regexp "</$tag>" $ token] } { 
80 set enoUtag 1 

continue 
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} else { 

append dat "$ token B 

} 



if {!$endLtag> { 

stacK-push $ns 
} else { 

10 set dat [string trim $dat] 

t o s_add_node $ns $eid 

set_node $ns $eid $tag $opt [XMLSTR $dat) $nod 

#puts - eid: $eid" 

15 #puts » tag: $tag" 

#puts ■ opts: [array get opt]" 

#puts " data: \"$dat\ B " 

#puts " nods: $nod" 

20 clear_state $ns 

} 

} elseif {[regexp {^<(\S+)> $ cmd mat tag]} { 
# start tag with arguments 
25 set eid [incr ID] 

set encL_tag 0 
set is_data 0 
set opt [list] 
30 set dat WB 

set nod [list] 
foreach token $args { 
if {$is_data> { 

if {[regexp "</$tag>" $ token ] } { 
35 set encL_tag 1 

continue 
) else { 

append dat "$ token " 

} 

40 } else { 

if [$token == ">»} { 
set is_data 1 
continue 
} elseif {$ token == •/>■} { 
45 set end_tag 1 

continue 

} elseif {[regexp { (\w+) = (\ » | V ) (\S+) (\ ' | \" ) > $ token mat key a val bj } { 
#puts "option: $key = \ H $val\" B 
#set opt($key> $val 
50 lappend opt $key $val 

) 

) 

) 

55 if {!$end_tag> { 

stack-push $ns 
} else { 

set dat [string trim $dat] 

tos_adcLnode $ns $eid 
60 set_jnode $ns $eid $tag $opt [XMLSTR $dat] $nod 

#puts - eid: $eid u 

#puts n tag: $tag" 

#puts ■ opts: [array get opt] n 

65 #puts * data: \"$datV B ' 

#puts ■ nods: $nod B 



70 



clear_state $ns 

} 



} else { 

# unknown command 

error "invalid command name \ B $cmd\" 

) 

75 

#puts ■ tag: $tag" 
#puts "data: $data" 
#puts "long: [llength $data] ■ 
#set cmd "set doc $data" 
30 #puts "cmd = $cmd" 
#set rv [eval $cmd] 
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#puts "doc = $doc" 

#if {[llength $doc] == 1 } { return [lindex $doc 0] ) 

#set rv [list tex::tag $tag [eval $doc] ] 

return 

5 } 

proc tex: :doc_set_xml { ns str > { 
variable TRACE 

if {$ TRACE) { puts -tex: :doc_set_xml : $ns $str° ) 

L0 

upvar #0 [join [list [namespace current] doc $ns xml_str] ::] xml_str 
set xml_str $str 

> 

L5 

proc tex: :doc_set_url { ns u } { 
variable TRACE 

if {$ TRACE) { puts "tex: : doc_set_ur 1 : $ns $u" ) 
>0 upvar #0 [join [list [namespace current] doc $ns url] ::] url 
set url $u 

) 

25 proc tex: :doc_get_url { ns ) { 
variable TRACE 

if {$ TRACE) { puts "tex: :doc_get_url: $ns" } 

upvar #0 [join [list [namespace current] doc $ns url] ::] url 

30 

return $url 

} 

proc tex : : doc_read { ns ) { 
35 variable TRACE 

if { $ TRACE } { puts "tex: :doc_read: $ns" ) 

upvar #0 [join [list [namespace current] doc $ns url] ::] url 

40 puts "url = $url" 

array set A [uri:: split $url) 
#foreach {key val) [array get A] { 
# puts B $key = $val" 
#) 

45 

switch $A( scheme) { 
"file" { 

set fh [open $A(path) r] 
set str [read $fh] 
50 close $fh 

doc_parse $ns $str 

> 

"http" { 

55 ) 

default { 

) 

) 

60 

} 

proc tex : : doc_parse { ns args ) { 
variable TRACE 
65 if { $ TRACE } { puts "tex: :doc_parse: $ns . . . " ) 

set i [interp create -safe A] 

interp alias $i unknown {) [namespace current] : :slave_unknown $ns 
#puts ■ aliases = [interp aliases $i] ■ 
7 0 regsub -all {;) [lindex $args 0] {\;) str 
#puts $str; exit 

if {[catch {interp eval $i $str) err]) { 
#puts " error = $err" 
error $err 
75 interp delete A 

) 

interp delete A 

} 

80 # regsubs < > & - 1 for xml... 
proc tex : : XMLSTR { str ) { 
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regsub -all {\;} $str {;> strl 
regsub -all (\&lti) $strl {<) str2 
regsub -all (\>) $str2 {» str3 
regsub -all {\&quot?) $str3 {"> str4 
5 regsub -all (\&apos;> $str4 <•) str5 
regsub -all {\&) $str5 {\&) str6 
return $str6 

> 

L0 if {0) { 

set doc [tex::create -url f ile: . /BackOl .xml] 
$doc read 
$doc dump 
exit 

15 > 

iah.antDtr.txt 

# Copyright (c) 2001, University of Utah 

# All rights reserved. 
# 

20 # iat.antptr.tcl 



namespace eval iat : : ant { 

variable pxl 
25 variable px2 

variable px3 

variable px4 

variable px5 

variable px6 
30 variable len 

variable siz 

set pxl 10 
set px2 10 
35 set px3 10 
set px4 10 
set px5 10 
set px6 10 

40 variable styleSizeSmall 0.002 
variable styleSizeDefault 0.005 
variable styleSizeLarge 0.010 

variable pointerNames [list none line wedge arrow] 

45 } 

proc iat: :ant: :calc_size { ns } { 
variable pxl 
50 variable px2 
variable px3 
variable px4 
variable px5 
variable px6 

55 

variable styleSizeSmall 
variable styleSizeDefault 
variable styleSizeLarge 

60 upvar #0 [join [list [namespace current] $ns imageX] ::] imageX 

upvar #0 [join [list [namespace current] $ns imageY] ::] imageY 

set percent 0.005 

#puts "calcOther: $iat : :roi: :size" 
65 set size default 
switch $size { 

"small" { set percent $ styleSizeSmall ) 

"default" { set percent $ styleSizeDefault } 

"large" { set percent $styleSizeLarge } 

70 } 

# ave of image x & y 

if ($imageX « 0} { return) 

if <$imageY == 0) { return) 
75 set ave [expr ($imageX + $imageY)/2 3 

set pxl [expr round (ceil ($ave * $percent) ) ] 

set px2 [expr $pxl * 2] 

set px3 [expr $pxl * 3] 

set px4 [expr $pxl * 4) 
80 set px5 [expr $pxl * 5] 

set px6 [expr $pxl * 6] 
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> 

proc iat j: ant: : point s_trans late { dx dy pts > { 
5 #puts "iat: :ant: :points_translate: $dx $dy B 

#puts ■ points = $pts B 
set newpts tlist] 
foreach pt $pts { 

set x lexpr [lindex $pt 0] + $dx] 
10 set y [expr [lindex $pt 1] + $dy] 

lappend newpts [list $x $yj 

) 

return $newpts 

> 

15 

proc iat: : ant: : point s_translate_ls t { dx dy pts } { 
set ptsn [list] 
foreach {x y) $pts { 

set xn [expr $x + $dx] 
20 set yn (expr $y + $dy] 

lappend ptsn $xn $yn 

) 

return $ptsn 

> 

25 

proc iat: :ant: :point_rotate { angle x y } { 

#puts n iat: :ant: :point_rotate: $angle $x $y" 
# rotate point around origin. . . 
set radius [expr sqrt ( ($x*$x) + ($y*$y) ) ] 
30 set radians [expr atan2 ($y, $x) ] 

set radians [expr $radians + (-l*$angle*3 .1416) /180] ; 
set xn [expr round ( ceil ($radius*cos <$radians) ) ) J 
set yn [expr round { ceil ($radius*sin($radians) ) ) ] 
return [list $xn $yn] 

35 } 

proc iat: :ant: :points_rotate { angle pts } { 
set ptsn [list] 
foreach {x y> $pts { 
40 set ptn [point_rotate $angle $x $y] 

set xn [lindex $ptn 0] 
set yn [lindex $ptn 1] 
lappend ptsn $xn $yn 

} 

15 return $ptsn 
) 

proc iat: :ant: :x2pts_length {ptl pt2} { 

#puts B 2ptsLength: $ptl $pt2" 
j0 set xl [lindex $ptl 0] 

set yl [lindex $ptl 1] 

set x2 [lindex $pt2 0] 

set y2 [lindex $pt2 1] 

if {$xl > $x2> { 
)5 set x [expr $xl - $x2] 

} else { 

set x [expr $x2 - $xl] 

) 

if ($yl > $y2} { 
>0 set y [expr $yl - $y2] 

> else { 

set y (expr $y2 - $ylj 

) 

set len (expr sqrt ( ($x*$x) +($y*$y) ) ] 
>5 return [list [expr round($len>] $x $y] 
) 

proc iat: :ant: :x2pts__angle {ptl pt2} { 
#puts n 2ptsAngle: $ptl $pt2° 
'0 set rv [x2pts_length $ptl $pt2] 
#set len (lindex $rv 0] 
set rvx [lindex $rv 1] 
set rvy [lindex $rv 21 
set radians [expr atan2 ($rvy, $rvx) J 
5 set angle [expr { ($radians*180) / (3 .1416) ) ] 

set x [expr [lindex $pt2 0]- [lindex $ptl 0]] 
set y [expr [lindex $pt2 1J- [lindex $ptl 1]) 

#puts "ptl « $ptl n 
0 #puts tt pt2 = $pt2" 

#puts "x = $x # y = $y" 
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if {$x == 0} { 

if {$y >= 0} { 

set angle [expr $angle + 03 
} else { 

5 set angle [expr $angle + 180] 

> 

) elseif ($x > 0} { 
if <$y == 0} { 

set angle (expr $angle + 0] 
10 } elseif {$y > 0} { 

set angle [expr $angle + 0] 

> else { 

set angle [expr 360 - $angle] 

) 

15 ) else { 

if {$y == 0} { 

set angle [expr $ angle + 180] 

> elseif {$y > 0) { 

set angle [expr 180 - $angle] 
20 } else { 

set angle [expr $angle + 180] 

> 

} 

return [expr -l*ceil ($angle) J 

25 > 

proc ia t : : an t : : point er_l ine { t len } { 

variable pxl 

variable px2 
30 variable px3 

variable px4 

variable px5 

variable siz 

set xo 0 
35 set yo 0 

set sss [expr round { ceil <$pxl/4) ) ] 

# line head 
set pts [list] 
lappend pts $xo $yo 

40 lappend pts [expr $xo + $px4] [expr $yo - $pxl] 
lappend pts [expr $xo + $px4] [expr $yo + $pxl] 

return $pts 

#return [list $lbl $pts] 

45 } 

proc iat : : ant : : pointer_arrow { tlen } { 

variable pxl 

variable px2 
50 variable px3 

variable px4 

variable px5 

variable siz 

set xo 0 
55 set yo 0 

# arrow head 
set pts [list] 
lappend pts $xo $yo 

lappend pts [expr $xo + $px3] [expr $yo - $px3] 
60 lappend pts [expr $xo + $px3] [expr $yo - $pxl] 
lappend pts [expr $xo + $px3] [expr $yo + $pxl] 
lappend pts [expr $xo + $px3] [expr $yo + $px3] 

return $pts 
65 #return [list $lbl $pts] 
> 

proc iat : : ant : : pointer_diamond { tlen} { 

variable pxl 
70 variable px2 

variable px3 

variable px4 

variable px5 

variable siz 
75 set xo 0 

set yo 0 

# diamond head 
set pts [list] 
lappend pts $xo $yo 

30 lappend pts [expr $xo + $px3] [expr $yo - $px2] 
lappend pts [expr $xo + $px5] [expr $yo - $pxl] 
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lappend pts [expr $xo + $px5] [expr $yo + $pxl] 
lappend pts [expr $xo + $px3] [expr $yo + $px2] 

return $pts 
5 #retum [list $lbl $pts] 
} 

proc iat s : ant : : create_pointer { ns type {size 0} } { 

10 calojsize $ns 

switch $type { 
"none" { 

return [pointer_line $size] 

15 } 

•line" { 

return [point er_line $size] 

} 

"arrow" { 

20 return [pointer_arrow $si2e] 

} 

"diamond" { 

return [pointer_diamond $size] 

} 

25 default { 

return -1 

} 

> 

} 

30 

proc iat ant: : near est_point {point points) { 
set mind 10000 
set idx 0 
set minidx 0 
35 foreach p $points { 

set rv [x2pts_length $point $p) 
set d [lindex $rv 0] 

if {$d < $mind> { set mind $dj set minidx $idx } 
incr idx 

40 } 

return $minidx 



proc iat : : ant : : gravity_angle { grav } { 
45 switch $grav { 
"N" { 

return 90 

) 

«E" { 

50 return 0 

} 

"S" { 

return 270 

) 

55 "W» { 

return 180 

) 

"NE" { 

return 45 

60 } 

"SB" { 

return 315 1 

) 

"SW" { 

65 return 225 

) 

"NW" { 

return 135 

) 

70 default { 

# C (center) 
return 0 

) 

> 

75 } 

proc iat : :ant: : gravityJLabel {angle} { 
set angle [expr $angle * -1] 
#puts " iat : : ant : : gravityLabel : $angle ■ 
80 # note: drawing begins at 0 degrees and rotates clockwise 
if {$angle > 0} ( 
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if ($angle < 90} { 

return w 
) elseif {$angle < 180} { 

return e 

5 } elseif <$angle < 270} { 

return e 
} elseif {$angle < 360} { 

return w 
} else { 
to return c 

} 

} else { 

return c 

} 

L5 } 

proc iat: :ant: : gravity LabelOld { grav } { 
switch $grav { 
°N" { 

10 return B s" 

} 

-E- { 

return M w" 

} 

25 "S" { 

return "n" 

} 

»W» { 

return B e B 

30 } 

n NE° { 

return "sw" 

} 

»SE° { 

35 return "nw" 

} 

"SW" { 

return "ne" 

} 

40 "NW B { 

return "se" 

} 

default { 

# C (center) 
45 return "c B 

} 

} 

} 

50 proc iat: :ant: :gravity_point { grav pts } { 

set wxi 0 ; set wxp 10000 ; set exi 0 ; set exp 0 
set nyi 0 ; set nyp 10000 ; set syi 0 ; set syp 0 
# find extremes . . . 
set idx 0 
55 for each {x y} $pts { 
if <$x < $wxp} { 

set wxp $x ; set wxi $idx 

} 

if <$x > $exp} { 
60 set exp $x ; set exi $idx 

} 

if ($y < $nyp} { 

set nyp $y ; set nyi $idx 

} 

65 if {$y > $syp} { 

set syp $y ; set syi $idx 

} 

incr idx 

} 

70 # return index of pt for gravity. 
switch $grav { 
°N B { 

return $nyi 

} 

75 "E" { 

return $exi 

} 

"S" { 

return $syi 

80 } 

"W" { 
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return $wxi 

} 

"NB" { 

if {$nyi == $exi) { 
return $nyi 

} 

if {$exi 0} { 

set exi [expr [llength $pts)/2] 

} 

if {$nyi == [expr $exi-l] } { 

return $nyi 
} else { 

return [expr round($nyi+ ( ($exi-$nyi) /2) ) ] 

) 

) 

B NW" { 

if ($nyi == $wxi} { 
return $nyi 

} 

if {$nyi == 0) { 

set nyi [expr [llength $pts]/2] 

} 

if {$nyi == [expr $wxi+l] > { 

return $nyi 
} else { 

return [expr round <$nyi- ( ($nyi-$wxi) /2) ) ] 

} 

> 

°SE° { 

if {$syi == $exi) { 
return $syi 

} 

if {$syi 0} { 

set syi [expr [llength $pts]/2] 

> 

if {$syi == [expr $exi+ll } { 

return $syi 
} else { 

return [expr round ( $syi- ( ($syi-$exi) /2) ) ] 

} 

) 

»SW" { 

if {$syi == $wxi) { 
return $syi 

} 

if {$wxi — 0> { ' 

set wxi [expr [llength $pts]/2] 

} 

if {$syi == [expr $wxi-l] } { 

return $syi 
} else { 

return [expr round($syi+ ( ($wxi-$syi ) /2) ) ] 

} 

} 

default { 

return -1 

} 



{0} { 

puts "testing. . . " 
set pi [list 1 0] 
set p2 [list 0 1] 

puts "Length [join $pl ,] [join $p2 [join [iat: :ant: :2ptsLength $pl $p2] :] n 

set pi [list 1 0] 
set p2 [list -1 0] 

puts "Length [join $pl ,] [join $p2 ,]: [join [iat : :ant: :2ptsLength $pl $p2] : 1 " 
set pi [list 1 1] 

set p2 [list -1 -1] a i in 

puts "Length [join $pl ,] [join $p2 ,]: [join [iat: :ant: :2ptsLength $pl $p2] :] 
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set pi [list 0 0] 
set p2 [list 1 0] 

puts "0 Angle [join $pl ,] [join $p2 ,]: [iat: :ant : :2ptsAngle $pl $p2] ■ 

5 set pi [list 0 0] 
set p2 [list 1 1] 

puts "45 Angle [join $pl ,3 [join $p2 [ iat :: ant :: 2pts Angle $pl $p2] ■ 

set pl (list 0 0J 
L0 set p2 [list 0 1] 

puts "90 Angle [join $pl »3 [join $p2 [ iat :: ant :: 2pts Angle $pl $p2]" 

set pl [list 0 0] 
set p2 [list -1 1] 

L5 puts "135 Angle [join $pl ,J [join $p2 [ iat : : ant : : 2ptsAngle $pl $p2] ■ 

set pl [list 0 0] 
set p2 [list -1 0] 

puts °180 Angle [join $pl ,] [join $p2 ,]: [ iat : : ant : : 2ptsAngle $pl $p23 * 

10 

set pl [list 0 0] 
set p2 [list -1 -1] 

puts "135 Angle [join $pl ,3 [join $p2 ,]: [iat: :ant: :2ptsAngle $pl $p23 - 

25 set pl [list 0 0] 
set p2 [list 0 -1] 

puts "270 Angle [join $pl ,3 [join $p2 ,]: [iat: :ant: :2ptsAngle $pl $p23* 

set pl [list 0 03 
30 set p2 [list 1 -13 

puts "315 Angle [join $pl ,3 [join $p2 ,3: [iat : :ant : :2ptsAngle $pl $p2]° 

set pl [list 1 1] 
set p2 [list 1 -13 

35 puts "270 Angle [join $pl ,3 [join $p2 ,]: [iat: rant: :2pts Angle $pl $p23" 

set pl [list 0 13 
set p2 [list 0 -13 

puts »270 Angle [join $pl ,3 [join $p2 ,]: [iat: :ant: :2ptsAngle $pl $p2]» 

40 

set pl [list -1 -13 
set p2 [list 1 -13 

puts "0 Angle [join $pl ,3 [join $p2 ,3: [iat : :ant: :2ptsAngle $pl $p21 B 

45 set pl [list 2 2] 

set p2 [list -3 -3] 

puts a 135 Angle [join $pl ,1 [join $p2 ,3: [iat: : ant: :2pts Angle $pl $p2] ■ 
exit 

50 } 

iat.antio.txt 

# Copyright (c) 2001, University of Utah 

# All rights reserved. 
# 

55 # iat.antio.tcl 

namespace aval iat:: ant { 
) 

60 

proc iat : : ant : : readLants { ns ur 1 } { 

puts tt iat : : ant : : readLants : $ns $url ■ 

} 

65 

proc iat :: ant : :wri tenants { ns url ) { 

puts " iat : : ant : :wri tenants : $ns $url " 

) 

70 

proc iat : : ant : : ants_reacLcmds { ns doc } { 
variable TRACE 

if {$ TRACE} { puts ° iat : : ant : : ants_read_cmds : $ns Sdoc" } 

75 variable antkey 
variable rawsave 
variable preond 

upvar #0 [join [list $doc doc_by_eid3 ::3 doc_by_eid 

80 upvar #0 [join [list $doc doc_Jby_elt3 ::3 docJby_elt 
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set rawsave 1 

if {[info exists doc_by_elt (annotations) ] } { 
set eids $doc_Jby_elt (annotations) 
5 #puts ■ eids = $eids" 

set eid llindex $elds end] 1 
if ($eid > 0> { 

#puts ■ ants * $doc_by_eid ( $eid) " 
array set A $docJby_eid($eid) 
10 set ants $A(nod) 

for each roi $ants { 

ants_read^cmds_ant $ns $doc $roi 

> 

) 

15 ) 

set rawsave 0 
return 0 

20 ) 

proc iat: :ant: : ants_read^cmds_ant { ns doc roi } { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :ants_read_cmds„ant: $ns $roi" > 

25 

variable thisptr 
variable order 

upvar #0 [join [list $doc doc_by_eid] ::] doc_by_eid 
30 upvar #0 [join [list $doc doO>y_elt] ::J doc_by_elt 

set precmd " [namespace current] : :$ns" 

if {[info exists doc_by_eid ( $roi ) ] } { 

35 

#puts ■ roi = $doc_by_eid($roi) ■ 
array set A $doc_by_eid ( $roi ) 
array set Ao $A(opt) 

40 # create roi with type 

set cmd "create roi $Ao(type)" 
set cmd "$precmd $cmd* 
#puts 0 cmd = $cmd" 
eval $cmd 

45 

if {[info exists Ao(order)}} { 

set cmd "set order $Ao (order)" 
set cmd "$precmd $cmd B 
#puts q cmd = $cmd" 
50 eval $cmd 

) 

set nods $A(nod) 
f oreach nod $nods { 
55 set cmds [list] 

set cmd " ■ 

#puts " nod = $doc_J>y__eid($nod) B 
array set B $doc_Jby_eid($nod) 
array set Bo $B(opt) 
50 set tag $B(tag) 

switch $tag { 
"views" { 

set cmd "set inview \{$B(dat)\>° 
lappend cmds $cmd 

55 } 

"code" { 

set cmd "set code \ ($B(dat) \) ■ 
lappend cmds $cmd 

} 

70 "symbol" { 

set cmd "set symbol \{$B(dat)\>" 
lappend cmds $cmd 

) 

"label" { 

75 set cmd "set label \{$B(dat)\>" 

lappend cmds $cmd 

) 

"cs_class" { 

set cmd "set cs_class \{$B(dat)\}" 
30 lappend cmds $cmd 

) 
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to 



10 



J5 



10 



15 



SO 



"CB_tumor" { 

set cmd "set cs_tumor \{$B(dat) \> ■ 
lappend cmds $cmd 

cs_node B { 

set and "set cs_node, \{$B(dat)\}° 
lappend cmds $cmd ' 

cs^etastasis " { 

set cmd "set csjnetastasis \{$B(dat) \) B 
lappend cmds $cmd 

cs_note B { 

set cmd "set cs_jiote \{$B(dat)\) B 
lappend cmds $cmd 

caption" { 

set cmd "set caption \{$B{dat)\) B 
lappend cmds $cmd 

vertexs ■ { 

set pts [list] 

f oreach pair $B(dat) { lappend pts [split $pair {,}] } 
set cmd "create vertexs (list $pts] ■ 
lappend cmds $cmd 

pointer* { 

set pts [list] 

set shp $Bo( shape) 

set txt $Bo<text) 

set tail [split $Bo(tail) {,)] 

f oreach pair $B(dat) ( lappend pts [split $pair {,}] } 

set cmd -create pointer $Bo(head) [list $tail] [list $pts] « 

lappend cmds $cmd 

set cmd "pointer style active $shp B 
lappend cmds $cmd 

set cmd "pointer symbol active $txt" 
lappend cmds $cmd 



> 



"color" { 
set cmd 
lappend 



"set 
cmds 



color 
$cmd 



$B(dat)< 



> 



) 

for each cmd $cmds { 
if {$cmd != { 

#set cmd " [namespace current] i 
set cmd ,, $precmd $cmd" 
#puts B cmd a $cmd , ' 
eval $cmd 



:$ns $line" 



} 



) 



55 



ant_save $ns 



return 0 



50 



proc iat : : ant : : ants_parse { ns ants } { 
variable TRACE 

if {$TRACE} { puts "iat: rant : :antsjparse: $ns $ants" } 

55 variable antkey 
variable rawsave 
variable precmd 

set rawsave 1 



70 



75 



30 



set lines [split $ants "\n"] 

f oreach line $ lines { 

if {$line == n ■ } { continue } 

if {[regexp $line] } ( continue ) 

#set cmd "[namespace current] : :$ns $line" 

set cmd "$precmd $line° 

puts " cmd = $cmd tt 

eval $cmd 

) 

set rawsave 0 
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return 0 

> 

5 proc iat: :ant: :ant_make_all { ns lvl } { 
variable TRACE 

if {$TRACE> { puts "iat: :ant: : ant_make_all : $ns $lvl° } 

upvar #0 [join [list [namespace current] $ns canvas] ::] canvas 
10 upvar #0 [join [list [namespace current] $ns polys] ::] polys 

set str 

#append str "begin annotations \n H 
15 set pre [string repeat " ■ $lvl] 

append str "$pre<annotations>\n" 
for each (key value) [array get polys] { 

append str [ant_make $ns $key [expr $lvl+2]] 

> 

20 #append str "end annotations \n° 

append str "$pre</annotations>\n M 

return $str 

> 

25 

proc iat: :ant: :ant_make { ns key lvl } { 
variable TRACE 

if { $TRACE } { puts "iat: :ant: :ant_make: $ns $key $lvl° } 

30 variable antkey 

variable order 

variable points 

variable heads 

variable verts 
35 variable tails 

variable dSYMs 

variable dPTRs 

variable kind 

variable color 
40 variable inview 

variable code 

variable symbol 

variable label 

variable caption 
45 variable cs_class 

variable cs_tumor 

variable cs_node 

variable cs.jnetastasis 

variable cs_note 

50 

upvar #0 [join [list [namespace current) $ns offsetX] ::] offsetX 
upvar #0 [join [list [namespace current) $ns offsetY) ::] offsetY 
upvar #0 [join [list [namespace current] $ns imageX] ::] imageX 
upvar #0 [join [list [namespace current] $ns imageY] ::] imageY 
55 upvar #0 [join [list [namespace current] $ns polys] ::] polys 

if {$key =a { set key $antkey } 

if {$key == "active") { set key $antkey ) 

ant_load $ns $key 

60 

set str »■ 

set roipts $points 

set roipts [points_translate -$offsetX -$offsetY $roipts] 
55 set roipts [pointsTolOK $imageX $imageY $ roipts J 

# append str "# key $antkey\n" 

set pre [string repeat ■ ■ $lvl] 

#append str "$pre<l — key $antkey — >\n" 
70 #append str "create roi $kind\n" 

append str n $pre<roi type=\ n $kind\" order=\ °$ order \" >\n" 

append str "$pre <views> [STRXML $ inview] </views>\n n 

append str °$pre <code> [STRXML $code] </code>\n" 

#append str "set symbol \ "$ symbol \ " \n" 
75 append str "$pre <symbol> [STRXML $symbol] </symbol>\n" 

#append str "set label \"$label\"\n" 

append str "$pre <label> [STRXML $label] </label>\n" 
append str "$pre <caption> [STRXML $caption] </caption>\n" 
# TNM Cancer Staging . . . 
50 append str "$pre <cs__class> [STRXML $cs_class] </cs_class>\n" 
append str "$pre <cs - .tumor> [STRXML $cs_tumor] </cs_tumor>\n" 
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append str "$pre <cs_node> [STRXML $cs_jnode] </cs_node>\n" 

append str "$pre <csjnetastasis> [STRXML $cs_jnetastasis] </cs_metastasis>\n" 
append str "$pre <cs_note> [STRXML $cs__note] </cs_jiote>\n" 
#append str "create vertexs { $roipts }\n" 
5 set vlst [list] 

foreach pt $roipts { lappend vlst (join $pt ","J } 
append str "$pre <vertexs> [join $vlst { )] </vertexs>\n" 
foreach {key value) [array get heads] { 
if {$ value MB > { continue > 
10 # added as extra data in output for processing... 

if {$value == n auto n > { 

set headpt [nearest_jpoint $tails($key) $points] 
} else { 

set headpt $value 

15 } 

set tailpt [points_translate -$offsetX -$offsetY [list $tails ($key) ] ] 
set tailpt [pointsTolOK $imageX $ image Y $ tailpt] 
set tailpt [lindex $tailpt 0] 

20 

set vertpts $verts($key) 

set vertpts [points_translate -$offsetX -$offsetY $vertpts) 
set vertpts [pointsTolOK $imageX $imageY $vertpts] 

25 #append str "create pointer $value \{$tailpt\} \{ $vertpts \}\n" 

set vlst [list] 

foreach pt $vertpts { lappend vlst [join $pt ",»] } 

append str "$pre <pointer head=\ B $value\ tt point=\"$headpt\" tail=V [ join $tailpt {,n\° 
shape=\"$dPTRs<$key)\" text=\"$dSYMs ($key) \" > [join $vlst { }] </pointer>\n" 
30 > 

#append str "set color \"$color\"\n" 
append str n $pre <color> $color < /color >\n n 
#append str "save\n° 
append str " $pre</roi>\n" 

35 

return $str 

) 

4 0 # regsubs < > & 0 • for xml . . . 
proc iat: rant: ; STRXML (str) { 

regsub -all {&) $str {\&amp/} strl 

regsub -all {<} $strl {\<> str2 

regsub -all {>) $str2 {\> } str 3 
45 regsub -all {\"> $str3 {\"> str4 

regsub -all {\»> $str4 {\&apos;} str5 

regsub -all {\n) $str5 { } str6 

return $str6 

> 

50 iat . thumbs . txt 

# iat . thumbs . tcl 

namespace eval iat:: thumbs { 
55 variable TRACE 0 
variable id 0 

> 

60 

proc iat: : thumbs :: proc { cname cmd args } { 
variable TRACE 

if {$TRACE} { puts "iat: : thumbs :: proc: $cname $cmd $args" } 

65 upvar #0 [join [list [namespace current] $cname callback_select] ::] callback's elect 

upvar #0 [join [list [namespace current] $cname callbacK-deselect] ::] callback^deselect 

switch $cmd { 

"configure* { 
70 foreach {key value) $args { 

switch — $key { 

"-url" { make_contact_sheet $cname $value ) 
"-callbackselect" { set callbacK,select $value ) 
"-callbackdeselect" { set callback_deselect $value > 

75 ) 
) 

} 

"cget- { 

#puts "proc = cget: $args n 
80 switch — [lindex $args 0] { 

"-borders" { return [get_borders $ cname] ) 
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) 

) 

« destroy" { 

return [widget_destroy $cname] 

5 ) 

default { 

) 

10 } 

return n " 

) 

15 

proc iat : : thumbs : : create { path ) { 
variable TRACE 

if {$TRACE) { puts " iat :: thumbs :: create s $path M } 
variable id 
20 variable sizes 

if {$path ■•■) { set path ■ ■ } 
set wid [incr id] 

set w [ScrolledWindow $path.w$wid -relief sunken -borderwidth 2] 
25 pack $w -side top -anchor nw -fill both -expand yes 
set path $w 

set f [ScrollableFrame [$path getframel.f -areawidth 0 -areaheight 0] 
pack $f -side top -anchor nw -fill both -expand yes 
30 set path $f 

#set c [canvas [$path get frame] .c -width 2 -height 2 -borderwidth 2 -background gray] 
$w setwidget $f 

35 #pack $c -anchor nw -fill both -expand yes 

set ns [namespace current] :: thurob$wid 
namespace eval $ns ( 
variable widget 
40 variable frame 

variable url 

variable callbacks select "noop" 
variable callback_deselect "noop" 

45 

} 

upvar #0 [join [list $ns widget] ::] widget 
upvar #0 [join [list $ns frame] ::] frame 

50 set widget $w 
set frame $f 
#set canvas $c 

#set annotations [iat :: ant :: create -canvas $c -cmdcanvas [namespace current] : ;canvas$wid ] 
#puts " annotations = $annotations ■ 

55 

set wcmd "proc [namespace current] : :thumb$wid { cmd args } (eval [namespace current] : :proc thumb$wid 
\$cmd \$args} n 

namespace eval : : $wcmd 

60 # default behavior it to pan it... 

#bind $c <ButtonPress-l> w [namespace current] : :toolStartPan $f %W %x %y D 
#bind $c <Buttonl-Motion> " [namespace current] : r toolDoPan $f %W %x %y M 

return [namespace current] ; :thumb$wid 

55 ) 

proc iat: : thumbs : :widget_des troy { ns ) { 
variable TRACE 

if {$ TRACE} { puts "iat: : canvas : :widget_des troy: $ns" } 
70 variable id 

variable sizes 

upvar #0 [join [list [namespace current] $ns widget] ::] widget 

75 pack forget $widget 
s : destroy $widget 

) 

proc iat : : thumbs : :make_contact_sheet { ns new_url ) { 
30 variable TRACE 

if { $ TRACE} { puts "iat: :appi :folder_make_contact_sheet: $ns $new_url n } 
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upvar #0 [join [list [namespace current] $ns frame] ::] frame 
#upvaf #0 [join [list [namespace current] $ns image_canvas ] ::] image_canvas 
upvar #0 [join [list [namespace current] $ns url] ::] url 
5 upvar #0 [join [list [namespace current] $ns callback^select] ::] callback_select 

make_thumbnails $ns $new_url 

set url $new_url 

10 

regexp {^f ile: ( . *) } $url m srcPath 

set tmpPath [file join $srcPath 00_TMP] 

set tmbPath [file join $tmpPath T] 

15 set files [glob [file join $tmbPath *.JPG]J 

#pack forget $image_frame 
#set wpath $image_ frame 
#destroy $image_frame 

20 

#set image_frame [frame $image_frame] 
#set csf $image_frame 

set f [$frame getframe] 

25 

# canvas $csf. canvas -width 10 -height 10 \ 

# -yscrollcommand [list $csf.yscroll set] 
#scrollbar $csf .yscroll -orient vertical \ 

# -command [list $csf .canvas yview] 
30 #pack $csf .yscroll -side right -fill y 

#pack $csf .canvas -side left -fill both -expand true 
#grid $top.c. canvas $ top. c. yscroll -sticky news 
#pack $csf -side top -fill both -expand true 

35 #set f [frame $csf. canvas. f -bd 0] 

#$csf .canvas create window 10 10 -anchor nw -window $f 

set btns [list] 
set colmax 3 
40 set col 0 

set n 0 

for each {img_file> $files { 

45 if {[file exists $img_f ile] } { 

set tmb [image create photo -file $img_file] 
set ant_file [f ile_for_ants $ns $img_file] 
set btn [frame $f .tmb$n] 

50 

if {$ant__file ==««}< 

set c [ iat : : canvas : : thumbnail $btn] 

$c configure -callbacks elect n $callback_select $ns \ u $img_f ile\ ° " 
$c configure -file $img_file 
55 $c redraw 

} else { 

set c [ iat :: canvas :: thumbnail $btn] 

$c configure -callbackselect " $callback_select $ns \"$irog__ f ile\" ■ 
$c configure -file $img_file 
60 set fh [open $ant_file r] 

set svg [read $fh] 
close $fh 
set ants M M 

regexp {<IAT>. *</IAT>} $svg ants 
65 # parse here. . . pass reference. . . 

set doc [tex: : create -xml $ants] 

$doc parse 

#$doc dump; exit 

$c annotations read^cmds $doc 
70 #$c annotations readUcmds $ants 

$c redraw 

> 

} else { 

75 set btn [button $f .tmb$n -text X] 

> 



lappend btns $btn 
incr n 
80 incr col 
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if {$col >= $colmax) { 

set cmd "grid (join $btns] -padx 4 -pady 4" 
eval $cmd 
set btns [list] 
5 set col 0 

> 

#grid $btnl $btn2 $btn3 -padx 4 -pady 4 
#pack $btn 

10 ) 

#tkwait visibility $csf .canvas 
#set bbox [grid bbox $f 0 0) 
#set incr [1 index $bbox 3] 
15 #set width [winfo regwidth $f 3 

#set height [winfo reqheight $f ] 

#$csf. canvas config -scrollregion "0 0 $width [expr $height+50] ■ 
#$csf. canvas config -yscrollincrement 20 

#$csf .canvas config -width $width -height [expr $height+50] 

20 

} 

proc iat: : thumbs : :make_thumbnails { ns url } { 
variable TRACE 

25 if {$TRACE} { puts "iat: : thumbs : ;make_thumbnails: $ns $url° } 

set old [focus] 

toplevel .d -borderwidth 10 
30 wm title .d "Contact Sheet" 

wm protocol .d WM_PELETEJWINDOW {set : :OK 1} 

regexp {*f ile: ( . *) ) $url m srcPath 
set tmpPath [file join $srcPath 00__TMP] 
35 set tmbPath [file join $tmpPath T] 

if { I [file exists $tmpPathJ } { file mkdir $tmpPath } 
if { I [file exists $tmbPath] } { file mkdir $tmbPath } 

40 set files [glob [file join $srcPath * . {TIF, PNG, JPG) ] ] 

set lb [label .d.lb -text "Creating thumbnails, please wait.,."] 
pack $lb -side top -expand y -fill x 

45 set :: progress 0 

set pb [ProgressBar .d.pb -variable progress -maximum [llength $f iles] ] 
pack $pb -expand y -fill x 

foreach file $files { 
50 #puts "file; $file» 

set newfile [lindex [file split [file rootname $f ile] ] end] 
set newfile [file join $tmbPath $newfile. JPG] 
#append newfile .JPG 
#puts "new file: $newfile° 
55 if {I [file exists $newf ile] ) { 

set srclmg [image create photo -file $file] 
set tmblmg [image create photo] 
$tmblmg copy $ srclmg -subsample 8 -shrink 
$tmblmg write $newfile -format JPEG 

50 } 

incr : : progress 

} 

grab release .d 
35 focus $old 

destroy .d 

} 

70 proc iat :: thumbs :: file_for_ants { ns tirib ) { 
variable TRACE 

if {$TRACE> { puts "iat: : thumbs : : url_f or_ants : $ns $tmb" ) 
#regexp {*f ile: ( . *) \ . \S+$> $url m base 

75 

set tparts [file split [file rootname $tmb] ] 
set iparts [lrange $tparts 0 [expr [llength $tparts]-4] } 
#set if ile [file join $iparts] 
lappend iparts [lindex $tparts end] 
iO set base [eval "file join $iparts"] 
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#puts "base = $base" 
set tmp "$base.svg" 

if {[file exists $trop] > ( return "$tmp" ) 
set tmp "$base.SVG" 
5 if {[file exists $tmp] } { return "$tmp" } 

return ■ ■ 

> 

iat . var. is4sv<7. txt 

10 



15 



20 



25 



30 



proc iat: :var_str_Js4svg {} { 
set str M « 

append str "<] — ECMAScript — > \n° 

append str p <script type= 1 text/ecraascript * >< ! \ [CDATAYt \n" 

append str n \n B 

append str "function antAbout {) \n" 

append str ■ { \n" 

append str " var msg = \ "Generated by IAT version O.8.3\ 0 ; \n" 

append str ■ alert (msg); \n" 

append str B } \n M 

append str ■ \n" 

append str "function antMakeMenu () \n" 



append str 
append str 
contextMenu > ; 
append str 
append str 
append str 



>{ \n* 



\n" 



var tmpMenuRoot = parseXMM printNbde( document .getElementByld { 'NewMenu' ) >, 



35 



40 



45 



50 



55 



50 



55 



70 



75 



*0 



contextMenu . replaceChi Id ( tmpMenuRoo t , contextMenu . f ir s tChi Id ) ; \n ■ 
} \n« 
\n" 

append str "function antShowCaption (key) \n" 
append str " { \n* 

//alert (\ n caption key: \ M +key); \n" 

var lblelt = document .getElementByld (key*' -label ') ; \n M 
var capelt « document . getElementByld (key+ * -caption 1 ) ; \n" 
if ( capelt. firstChild == null ) { return? } \n» 
var lblstr = lblelt . firstChild. data; \n" 
var capstr = capelt . firstChild. data; 
\n" 

var new_str = lblstr+\"\\n\\n\" ; \n" 
var s = 0 \n n 
var e » 50; \n" 

/ / alert ( \ " length : \ " +capstr . length) ; 
while ( e < capstr . length ) \n" 
{ \n" 

if( capstr.charAt (e) .match (/\s/) 
{ \n» 

new_str = new_str+\ n \\n\" + capstr .substring (s, e) ; 
s » e+1; \n° 
e a e + 49; \n" 
} \n" 
e++; \n- 
} \n" 

new-jstr = new_str+\ 0 \\n\"+capstr .substring (s, capstr . length) ; \n" 
alert ( new_s t r ) ; \n * 
\n" 



append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 



\n" 



\n" 



) \n" 



\n« 



\n" 



append str "function antToggleShowAll (arr, menu) \n" 



append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 
append str 



'< \n" 



//alert ( ♦keys: 1 +arr) ; \n" 
for( var i in arr) \n" 
{ \n" 

//alert( 'key: , +arr\[i\3)j \n" 
antToggleShowAnt (arr\ £i\] , false) ; 
) \n° 



\n- 



\n" 



\n" 



' if( menu ) antMakeMenu () ; 
') \n" 
' \n" 

'function antToggleShowAnt (key, menu) \n" 
'{ \n" 

1 //alert ( 'key: '+key); \n n 

' var item = document .getElementByld ( 'menu- 1 +key+ ' -annotation' ) ; \n" 
1 \n" 

if( item.getAttribute( 'checked') 'yes') \n» 
{ \n u 

' antSetShowAnt (key, false) ; \n» 

) else { \n a 
• ant SetShowAnt (key, true) ; \n" 

) \n" 

' \n" 
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append str " if{ menu ) antMakeMenu {) ; \n" 
append str B ) \n B 
append str " \n B 

append str -function antSetShowAll (arr, show, menu) \n" 
5 append str ■ { \n° 

append str " / /alert ( 1 keys : »+arr>; \n B 
append str " for( var i in arr) \n" 
append str ■ { \n" 

append str - //alert ( 'key: , +arr\ti\]); \n B 

.0 append str - antSetShowAnt (arr\[i\] , show, false); \n° 

append str » > \n" 
append str * \n B 

append str ■ if ( menu ) antMakeMenu ( ) ; \n" 
append str ■ } \n" 
.5 append str ° \n° 

append str "function antSetShowAnt (key, show, menu) \n" 
append str °{ \n° 

append str ■ //alert ( 'annotation: ' +ant); \n B 

append str • var item = document . getElementByld (' menu- ' +key+ 1 -annotation ') ; \n B 
>0 append str 0 var elt = document .getElementBy Id (' ALL- '+key+ ' -annotation 1 ) ; \n" 
append str » var style = elt .getStyle{ ) ; \n" 
append str ■ //alert ( 1 element : *+elt); \n B 
append str B \n° 

append str " if < show == false ) \n" 
15 append str ■ { \n" 

append str ■ item, set At tribute ( 'checked* , 'no'); \n" 

append str ■ style. setPropertyt 'visibility ', 'hidden' ) ; \n M 

append str " } else { \n B 

append str ■ item, set Attr ibute < 1 checked' , 1 yes ') ; \n B 

JO append str " style. setPropertyt 'visibility' ,' inherit* ) ; \n" 

append str ■ } \n" 
append str ■ \n" 

append str 0 if{ menu ) antMakeMenu {) ; \n B 
append str 0 } \n p 
J 5 append str " \n" 

append str "function antToggleMouseOverAll (arr, menu) \n" 
append str n { \n B 
append str • \n* 

append str ■ var item = document . getElementBy Id ( 'menu -mouseovers ') ; \n" 
10 append str 0 \n° 

append str B if ( item, ge t Attr ibute ( 1 checked* ) == 'yes') \n n 
append str n { \n M 

append str ■ item, set At tribute ( 'checked' , 'no'); \n B 

append str B ant SetMouseOver All (arr , true, false) ; \n B 

J 5 append str ■ antMouseOver = false; \n B 

append str " ) else { \n" 

append str " antMouseOver = true; \n B 

append str ° item. setAttribute( 'checked' , 'yes'); \n B 

append str B ant SetMouseOver All (arr , false, false) ; \n B 

SO append str " } \n B 

append str B \n" 

append str B if ( menu ) antMakeMenu ( ) ; \n B 
append str B ) \n B 
append str B \n B 

35 append str "function ant SetMouseOver All {arr, over, menu) \n B 
append str " { \n" 

append str 8 //alert ( 'keys: «+arr); \n° 
append str B for( var i in arr) \n" 
append str " { \n B 
50 append str - //alert ( 'key: ' +arr\ [i\ J ) ; \n B 

append str B ant SetMouseOver Ant (arr\ [i\] , over, false); \n" 

append str B } \n B 
append str B \n D 

append str " if ( menu ) antMakeMenu ( ) ; \n B 
55 append str ■ ) \n B 
append str B \n B 

append str "function antSetMouseOverAnt (key, over, menu) \n" 
append str ■ { \n" 
append str B \n" 

70 append str B var elt = document . getElementByld ( ' ALL- ' +key+ * -annotation ' ) ; \n B 
append str B var style » elt.getStyleO ; \n B 
append str ■ \n" 

append str ■ if ( antMouseOver == true) \n B 
append str B { \n B 
75 append str B if ( over == false ) \n B 

append str B { \n tt 

append str n style . setProperty ( 1 opacity 1 , 0 ) ; \n " 

append str B ) else { \n B 

append str ■ style . setProperty ( 1 opacity ' , 1 ) ; \n" 

30 append str " } \n B 

append str B } \n B 
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append str •} \n° 
append str " \n° 

append str B var antMouseOver = false; \n B 
append str B current_view - 'ALL'; \n B 
5 append str » \n B 

append str °var newMenuRoot = parseXML( printNode ( document . getElementByld ( 'NewMenu 1 ) ), contextMenu 
)} \n« 

append str " contextMenu . replaceChild ( newMenuRoot, contextMenu. firstChi Id ); \n° 
append str ■ \n» 
10 append str «\) \] ></script> \n" 
append str - \n B 
return $str 

> 

iat . dialog - dataref . txt 
15 # Copyright (c) 2001, University of Utah 

# All rights reserved. 
# 

# iat. dialog. da taref .tcl 

20 proc iat: : dialog :: dialog_edi t_data_test {} { 
return [list code symbol label] 

} 

proc iat: .-dialog*. :tree_click_node { id } { 
25 variable TRACE 

if {$TRACE} { puts "iat: : dialog : : tree_click_node : $id B } 

variable ref_tree 
variable ref_id_.to_.lst 
30 variable ref_code 

variable ref_symbol 
variable ref_label 

if {![info exists ref_i6_.to_.lst ($id) ] } { return ) 
35 $ref_tree selection clear 

$ref_tree selection add $id 

set 1st $ref_id_.to_lst($id) 

set ref_code [lindex $lst 1] 

set ref_symbol [lindex $lst 2] 
40 set ref_label [lindex $lst 3) 

> 

proc iat: : dialog : :combo_select_ref {} { 
45 variable TRACE 

if { $TRACE} { puts "iat: : dialog : :combo_select_ref : B } 

variable ref_list 
variable ref_combo 

50 

set idx r$ref_combo getvalue] 
if {$idx == 0} { 

# NONE list item 

return 

55 } 

set name [lindex $ref_list $idx] 
#puts u name = $name" 

set url B $iat: :app: :rsrc_url /references /$name. TXT 0 
#puts • url = $url" 

60 

load_.ref_.fi le $name $url 

} 

proc iat: : dialog : :load_xef_leaf { branch leaf Ivl ) { 
65 variable TRACE 

if {$TRACE} { puts "iat: : dialog : : load_.ref_.leaf : $branch $leaf $lvl tt } 

variable ref_tree 
variable ref_id_.to_.lst 

70 

if {t[info exists ref_io_to_lst ($branch)] ) { return ) 
set nevOoranch $branch 
set next_leaf $leaf 

while {[info exists ref_id_.to_lst {$next_leaf ) ] > { 
75 set line $ref_ia_to_lst ($next_leaf ) 

set next_lvl [lindex $line 0] 
if {$next_lvl == $lvl} { 
#incr ref_id 

set newjbranch [$ref_tree insert end $branch $next_leaf -text B [lindex $line 1] : [lindex $line 

80 3] B ] 

set next_leaf [expr $next_leaf +1] 
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} elseif {$next_lvl > $lvl} { 

set next_leaf [load_ref_leaf $newjbranch $next_leaf $next_lvl] 
> else { 

return $next_leaf 

5 ) 
) 

return $next_leaf 

} 

10 

proc iat: : dialog ; : load^ref _f ile { name url } { 
variable TRACE 

if {$TRACE> { puts "iat: : dialog : :loacLref_f ile: $name $url° ) 

15 variable ref_name 
variable ref_file 
variable ref_tree 
variable ref_icLto_lst 

20 if {$name == "NONE"} { return } 

if {$ref_name !« $name} { 

if {ICregexp rfile:} $url)} { return ) 
set ref_file $url 
25 regexp {*file:(.*)> $url m path 

set fh [open $path r] 

set lines [split [read $fh] "\n"] 

close $fh 

30 

set ref_id 0 

array unset ref_io\_to_J.st 
array set ref_i<3L_to_lst [list] 

35 set ref_name $name 

set ref_icLto_lst ( $ref _id) "Sname" 

foreach line $lines { 

if (Cregexp {^\s*$> $line] > { continue } 
40 incr ref_id 

set ref_ icLto__lst <$ref_id) $line 
#puts ■ $ref_id = $line" 

} 

} 

45 

# branch, leaf, level 

$ref_tree delete C$ref_ tree nodes root] 

set root [$ref_tree insert end root 0 -text "$name n ] 

loader ef_leaf 0 10 

50 

) 

proc iat; : dialog : :load_ref_list { url } { 
variable TRACE 

55 if {$TRACE> { puts -iat:: dialog : : loacLref _list : $url" } 

variable ref_list 

if {ICregexp {*file:> $url] } { return > 
60 regexp {*file:(.*)> $url m path 

set files [glob $path/*.txt] 

#puts " reflst = $reflst° 

set ref_list [list NONE] 

foreach file $files { 
65 set name [file tail [file rootname $f ile] J 

lappend ref_list $name 

> 

) 

70 

proc iat: : dialog: :dialog_edit_data {) { 

variable ref_list 
variable ref_combo 
75 variable ref_name 
variable ref_file 
variable ref_tree 

variable ref__code 
80 variable refL_symbol 
variable ref_label 
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set path $iat : :app: :rsrc__url /references 
regexp {"file: (.*)} $path m path 
if { i [file exists $path] } { 
5 tKjnessageBox -type ok -icon warning -title "Resources" -message "Unable to access: $path" 

return 

) 

if {[llength $ref_list] == 1} { 
10 set ref_name "NONE" 

set ref_file " " 

load_.ref_JList $iat: :app: :rsrc — url/references 

) 

15 set old [focus] 

toplevel .d -borderwidth 10 
wm title .d "References" 

wm protocol .d W**JDELETE_.WINDOW {set : :OK 1} 

20 

set f [frame .d.f] 

pack $f -fill both -expand yes 

set dl [label .d.f.dl -text "Current Reference:"] 
25 set dc [ComboBox .d.f.dc -values $ref_list -modifycmd ■ iat :: dialog :: combo_.se lector ef " ] 
grid $dl $dc x x -pady 4 
set ref_combo $dc 

$ref_combo setvalue ©[lindex [lsearch $ref_list $ref_name] 0] 

30 set tf [frame .d.f.tf] 

grid $tf - - - -sticky news 

set tree [Tree $tf .t -width 40 -height 20 -padx 22 -deltay 22\ 
-yscrollcommand [list $tf.yscroll set] \ 
-opencmd " n ] 

35 set sbar [scrollbar $tf .yscroll -orient vertical \ 
-command [list $tf .t yview] 3 
grid $tree $sbar -sticky news 
set ref_,tree $tree 
loa6_ref_file $ref_name $ref__file 

40 

$tree bindText <Button-l> " iat : : dialog : : tree_click_jiode ■ 
set : : OK 0 

button .d.f. ok -text OK -command {set : :OK 2} 
45 button .d.f. cancel -text Cancel -command {set : :OK 1} 
grid x x .d.f. ok .d.f .cancel -pady 4 

focus . d 
grab .d 
50 tkwait variable ::0K 

grab release .d 
focus $old 
destroy .d 

55 

if {$::0K !- "2") {return [list]} 

return [list $ref_code $ref_,symbol $ref_label] 

) 

60 iat . dialog . groups . txt 

# Copyright (c) 2001, University of Utah 

# All rights reserved. 
# 

# iat . dialog . border . tcl 

65 

proc iat: : dialog : :dialog_edit__groups_test {) { 
return [list .20 .20 .20 .20] 

} 

70 proc iat : : ant : : grp_.dlg__drop_.ant { ns tree xxx where cmd type data } { 
variable TRACE 

if {$ TRACE} { puts " iat : ; ant : : grp__dlg_drop__ant : $ns $tree $where $cmd $type $data" } 

set rel [lindex $where 0] 
75 if {$rel == "bad"} { 

set parent [$tree parent $data] 

set nodes [$tree nodes $parent] 

#puts "old nodes = $nodes" 

set oldidx [lsearch -exact $nodes $data] 
80 set nodes [Ireplace $nodes $oldidx $oldidx] 

set newidx [lsearch -exact $nodes [lindex $where 1]] 
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set nodes [linsert $nodes $newidx $data] 

#puts "new nodes a $nodes" 

$tree reorder $parent $nodes 
} elseif {$rel == -node-) { 
5 set newparent [1 index $where 1] 

$tree move $newparent $data 0 
} elseif {$rel == "position") { 

set newparent [lindex $where 1] 

set newpos [lindex $where 2] 
10 $tree move $newparent $data $newpos 

} else { 

# do nothing . . . 

) 

) 

15 

proc iat : :ant : :grp_dlg_make_leaf { ns tree branch order } { 
variable TRACE 

if {$TRACE} { puts "iat: :ant: :grp_dlgj3Uild^_leaf : $ns $tree $branch $order* } 

20 variable ord2key 
variable leaf_id 
variable symbol ° " 
variable label 

25 set key $ord2key ($order) 
ant_load $ns $key 

set new_leaf [$tree insert end $branch [incr leaf_id] -text "$symbol: $label" -data $key] 

30 set idx 1 

while {$idx < 20} { 

if {[info exists ord2key ($order . $idx) ] } { 

grp_dlg_jmake_leaf $ns $tree $new_leaf $order.$idx 

> 

35 incr idx 

> 

) 

4 0 proc iat : : ant : : grp_dlg_make_tree { ns tree > { 
variable TRACE 

if {$ TRACE) { puts "iat: :ant: :grp_dlg_build_tree: $ns $tree° ) 

variable ord2key 
45 variable leaf_id 

upvar #0 [join [list [namespace current] $ns orders] ::] orders 

array unset ord2key 
50 array set ord2key [list] 
set leaf_id 0 

for each {key val) [array get orders] { 
#puts "key: $key = $val° 
55 set ord2key($val) $key 

) 

set new_leaf [$tree insert end root 0 -text "IMAGE" ] 

60 set idx 1 

while {$idx < 20} { 

if {[info exists ord2key($idx) ] } { 

grp_dlg_jmake_leaf $ns $tree 0 $idx 

) 

65 incr idx 

} 



ant_create__defaults 



70 } 



75 



proc iat: :ant: :grp_dlg_ read^leaf { ns tree branch {order ■ " } } { 
variable TRACE 

if { $ TRACE } { puts B iat: :ant: :grp_dlg_rea6Uleaf : $ns $tree $branch $order° } 
upvar #0 [join [list [namespace current] $ns orders] ::] orders 



if {$branch == 0} { 
set order 00 
30 } else { 

set key [$tree itemcget $branch -data] 



WO 2004/057439 



- 139 - 
Appendix 2 



set orders ($key) $order 
#puts "key: $key « $order" 
append order ■ . M 

} 

5 

set i<3x i 

set nodes [$tree nodes $branch] 
f oreach node $nodes { 

grp_dlg_reacL_leaf $ns $tree $node $order$idx 
10 incr idx 

) 

) 

proc iat: : ant:: grp_dlg_read.tr ee { ns tree } { 
15 variable TRACE u _ 

if ($TRACE) { puts "iat: :ant: :grp_dlg_read_tree: $ns $tree ) 

grp_dlg_read_leaf $ns $tree 0 

20 > 

proc ia t : : dialog : : dialog_edi t_groups { ants } { 
variable TRACE 

if {$TRACE} { puts -iat: : dialog ::dialog_edit_groups: $ants } 

25 

variable grp_tree 

set ns [lindex [split $ants "::"] end] 
set old [focus] 

30 

toplevel .d -borderwidth 10 

wm title .d "Annotation Groups" 

wm protocol .d WM_DELETE_WINDOW {set : :0K 1} 

35 set f [frame .d.f] 

pack $f -fill both -expand yes 

set tf [frame .d.f.tf] 
pack $tf -fill both -expand yes 
40 #grid $tf sticky news 

set tb [frame .d.f.tb] 
pack $tb -fill x -expand no 

45 Tree $tf .t -width 40 -height 10 -padx 22 -deltay 22\ 
-yscrollcommand [list $tf .yscroll set] \ 
-dragenabled true \ 
-dropenabled true \ 
-opencmd " " \ 

5 o -dropcmd " iat : : ant : : grp_dlg_drop_ant $ns " 

set grp_tree $tf.t 

scrollbar $tf .yscroll -orient vertical \ 

-command [list $tf .t yview] 
pack $tf .yscroll -side right -fill y 
55 pack $tf .t -side left -fill both -expand true 

set : :OK 0 

button $tb.ok -text OK -command {set : :OK 2) 
button $tb. cancel -text Cancel -command {set : :OK 1} 
60 grid $tb.ok $tb. cancel -sticky e -pady 4 

# Build the annotation tree . . . 

iat : : ant : : grp_dlg_jnvake_tree $ns $grp_tree 

65 focus .d 
grab .d 

tkwait variable : :OK 

# Save the new grouping orders . . . 
70 if {$::OK « "2") { 

iat: :ant: :grp_dlg_read_tree $ns $grp_tree 

> 

grab release .d 
75 focus $old 
destroy .d 

return 0 

) 

80 iat . var . splash . txt 
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proc iat: :var_str_splash {} { 
set str "" 

append str "Electronic Medical Education Resource Group (EMERG) \n" 
5 append str "Medical linage Annotation Tool (MX AT or IAT vO.8.4) \n» 
append str ■ (c) 2001, 2002 University of Utah, SLC UT \n n 
append str " \n" 

append str "TECHNOLOGY EVALUATION - 2002.04.08 \n" 
append str " \n° 

10 append str "This software is property of the of the University of Utah and has been licensed through 
the University of Utah Technology Transfer Office for software evaluation purposes only. This software 
application {iat.exe) may not be copied, distributed or presented outside of the licensing organization. \n" 
append str ■ \n° 

append str "This software may only be used to test and evaluate included software functionality for use 
15 in an academic or commercial environment. This version of the MI AT /IAT software application represents the 
core annotation mechanisms, and does not include many of the available presentation, organization and 
translation methods that make the MI AT / IAT an end-user suitable software application. \n" 

append str ■ \n" 

append str "Direct questions, comments and problems regarding the MIAT to one of the following EMERG 
20 personnel. \n" 

append str ■ \n" 

append str ■ Technical Contact \n" 
append str ■ Jason Lauman \n" 
append str " jason.lauman@hsc.utah.edu \n* 
25 append str ■ 801-641-2944 \n" 

append str " Vn" 

append str " Licensing Contact \n" 
append str " Patricia Goede \n" 
append str 9 patricia.goede@hsc.utah.edu \n" 
30 append str ■ 801-585-1737 \n» 

append str ■ \n" 
append str " \n" 
append str "NO WARRANTY \n" 
append str " \n" 

35 append str "EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/ OR OTHER PARTIES PROVIDE 

THE SOFTWARE \"AS IS\" WITHOUT WARRANTY OP ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED 
TO, THE IMPLIED WARRANTIES OP MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. \n" 
append str ■ \n" 

append str "IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT 
40 HOLDER BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 
ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA 
BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. \n" 
append str • \n" 
45 return $str 
} 

iat . dialog . borders . txt 

# Copyright (c) 2001, University of Utah 

# All rights reserved. 
50 # 

# iat. dialog. border. tcl 



proc iat : : dialog : : dialog_edi t_porders_tes t { ) { 
return [list .20 .20 .20 .20) 

55 ) 

proc iat : : dialog : : dialog_edit_Jborders { 1st ) { 
set old [focus] 

60 

toplevel .d -borderwidth 10 
wm title .d "Edit Borders" 

wm protocol .d WM_PELETEJWINDOW {set : :OK 1} 

65 set vL »0"; set vT "0"; set vR "0"; set vB "0" 

regexp {\.(\d+)} [lindex $lst 0] match vL; append vL 

regexp {\.(\d+)> [lindex $lst 1] match vT; append vT "%" 

regexp (\.<\d+)} [lindex $lst 2] match vR; append vR "%° 

regexp (\.(\d+)> [lindex $lst 3] match vB; append vB n %" 

70 set :: iat: : dialog :: color [lindex $lst 4] 

set f [frame .d.f] 

pack $f -fill both -expand yes 

75 set eL [entry .d.f. el -width 4] 

set eT [entry .d.f .et -width 4] 

set eR [entry .d.f .er -width 4] 

set eB [entry .d.f.eb -width 4] 

set tl [label .d.f.tl]; set t2 [label .d.f.t2] 

80 set ml [canvas .d.f .c -width 64 -height 64] 

set bl [label .d.f.bl]; set b2 [label ,d.f.b2] 
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$inl cr eate rect 2 2 62 62 -width 2 -outline black 

grid $tl $eT $t2 
grid $eL $ml $eR 
5 grid $eB $b2 

$eL insert end $vL 
$eT insert end $vT 
$eR insert end $vR 
10 $eB insert end $vB 

label -d.f.cl -background $iat :: dialog :: color -width 4 

tatt ^on££ tse^Tfia^^^lor Ct^chooseColor -parent .d -initialcoior $! :iat: : dialog color 1 , 
15 .d.f.cl configure -background $: :iat: : dialog: : color) 

grid .d.f.cl .d.f.cb -pady 4 



set : : OK 0 

20 button .d.f.ok -text OK -command {set : :OK 2} 

button .d.f. cancel -text Cancel -command {set : :OK 1} 
grid .d.f.ok .d.f. cancel 



focus . d > 
25 grab .d 

tkwait variable : :0K 

set vL [$eL get] 
set vT ($eT get] 
30 set vR [$eR get] 
set vB {$eB get] 

regexp {(\d+)> $vL match x; set vL ■ . $x n 
regexp {(\d+>) $vT match x; set vT B .$x" 
35 regexp {(\d+)} $vR match x; set vR °.$x B 
regexp {(\d+)} $vB match x; set vB • . $x" 



grab release .d 
focus $old 
40 destroy .d 

if {$::0K 1= "2"} {return [list]} 

return [list $vL $vT $vR $vB $:: iat; : dialog :: color] 

45 ) 

iat . dialog . doc . txt 

# copyright (c) 2001, University of Utah 

# All rights reserved. 
# 

50 # iat. dialog. border. tcl 

proc iat : : dialog : : dialog_doc_test { } { 
return [list] 

} 

55 

proc iat; ; dialog : :dialog_doc { title txt } { 

set old [focus] 

60 toplevel .d -borderwidth 10 
wm title .d $title 

wm protocol .d W*CDELETE_WINDOW {set ::OK 1) 
wm minsize .d 400 400 
wm geometry .d 450x650 

65 

set f [frame .d.f] 

pack $f -fill both -expand yes 



70 set f [text .d.f .txt -width 60 -height 40 -wrap word -yscrollcommand [list .d.f. 

$f insert 1.0 $txt 

#pack $f -side left -fill both -expand yes 

set f [scrollbar .d.f.sb -command [list .d.f. txt yview] ] 
75 #pack $f -side right -expand y 



grid .d.f .txt .d.f.sb -sticky news 



80 



set : :OK 0 

button .d.ok -text OK -command {set ::OK 2) 
pack .d.ok -anchor c -pady 4 
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focus • d 
grab .d 

tkwait variable : :OK 

5 grab release .d 
focus $old 
destroy .d 

return [list] 

10 } 

iat.var.todo.txt 



15 proc iat: :var_str_todo {} { 
set str 

append str "MI AT vO.8.4 \n" 
append str "To Do List \n tt 
append str -2002.04.08 \n° 
20 append str " \n" 

append str "Contact sheet does not update to reflect changes in the image directory. \n" 
append str ■ \n" 

append str "Contact sheet shows annotations, but symbols drawn on images resize when \n" 
append str "an image is opened. Each canvas will have to maintain instance font \n B 
25 append str "preferences instead of using global preferences. \n B 

append str ■ \n" 

append str "Reorganize load/ save code so that it is more consistant for collaborative \n tt 
append str "annotations and other advanced used of annotations. \n n 
append str ■ \n" 
30 append str ■ \n n 
return $str 

} 

iat . txt 
# iat.tcl 

35 

source iat.app.tcl 

set app [iat ; :app: : create .] 
wm iconify . 

90 

$app configure -resources "file:/WORK_STATIC/iat-0.6/IAT" 
#$app configure -init_url 

#$app configure -init_url ■ /WORK/NIHSV12/NIHSV/00_DB/ images /tissue" 

15 

#$app configure -url " f ile : /windows /desktop/ images /Backlmages/BackOl .PNG" 
#$app configure -url "file: /images /HeadAn<3Neck/01_CT_2_2 5 .PNG" 

#$app configure -url B file : /work/iat-0 . 6/src/tclhttpd/htdocs/APC_l_l.JL0x. jpg" 
50 #$app configure -url "file: /WORK_STATIC/iat-0 . 6/src/tclhttpd/htdocs/01_CT_2_25.PNG" 
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